I created a program to create and send receipts automatically at work instead of me sending them automatically. I'm not good at VBA and managed to create this looking aroung online. It works but I would like to add a condition in there that only sends the receipts when this condition is met
cfws.Range("N" & I).Value = "no"
I know it's a simple If but I just can't figure it out in VBA. I used to code in C++ and Java more than 15 years ago, that's why I can read the language but I don't know how to add the If here.
Do I start the If after I create the pdf files or after creating the outlook object? I'm lost. I tried several things but on most of my attempts, I get an error saying there's no For for my next.
Thank you for your help.
Option Explicit
Sub CopyToTemplate()
Dim cfws As Worksheet
Dim ctws As Worksheet
Dim lastrow As Long
Dim I As Long
Dim fileloc As String
Dim filename As String
Dim Fname As String
Dim OutlApp As Object
Dim IsCreated As Boolean
Dim Count As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set cfws = Worksheets("Monthly data")
Set ctws = Worksheets("Template")
Count = 0
lastrow = cfws.Cells(cfws.Rows.Count, "B").End(xlUp).Row
fileloc = "C:\Users\dave.i\Documents\Project\Receipts\"
'This creates the receipt
For I = 2 To lastrow
filename = "DCN #" & cfws.Range("A" & I).Value & " receipt"
ctws.Range("C41").Value = "Sub ID " & cfws.Range("A" & I).Value
ctws.Range("D14").Value = cfws.Range("B" & I).Value
ctws.Range("C43").Value = cfws.Range("B" & I).Value
ctws.Range("D13").Value = cfws.Range("C" & I).Value
ctws.Range("C42").Value = cfws.Range("C" & I).Value
ctws.Range("C44").Value = cfws.Range("D" & I).Value
ctws.Range("C45").Value = cfws.Range("E" & I).Value
ctws.Range("D15").Value = cfws.Range("D" & I).Value & ", " & cfws.Range("E" & I).Value
ctws.Range("I45").Value = cfws.Range("F" & I).Value
ctws.Range("I46").Value = cfws.Range("G" & I).Value
ctws.Range("I47").Value = cfws.Range("H" & I).Value
ctws.Range("C45").Value = cfws.Range("E" & I).Value
ctws.Range("B51").Value = cfws.Range("I" & I).Value
ctws.Range("H50").Value = cfws.Range("J" & I).Value
ctws.Range("B56").Value = "Charged to " & cfws.Range("K" & I).Value & " on"
ctws.Range("B57").Value = cfws.Range("L" & I).Value
'This names the receipt and creates it
Fname = fileloc & filename & ".pdf"
With ctws
.ExportAsFixedFormat Type:=xlTypePDF, filename:=Fname
End With
'Time to send the receipts
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
**'Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Subject = "Daily Commercial News receipt #" & cfws.Range("A" & I).Value
.To = cfws.Range("M" & I).Value
'.CC = "..." ' <-- Put email of 'copy to' recipient here
.Body = "Hello," & vbLf & vbLf _
& "Attached is the receipt for your monthly subscription." & vbLf & vbLf _
& "Please do note hesitate to contact us should you have any other concerns." & vbLf & vbLf _
& "Best Regards," & vbLf _
& Application.UserName & vbLf _
& "Customer Service representative" & vbLf _
& vbLf & vbLf
.Attachments.Add Fname
' Try to send
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail to " & cfws.Range("M" & I).Value & " was not sent", vbExclamation
Else
Count = Count + 1
End If
On Error GoTo 0**
End With
Next I
'Sends the number of emails sent
MsgBox Count & " E-mails successfully sent", vbInformation
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Aucun commentaire:
Enregistrer un commentaire