I've created a program to create and send receipts. I managed this by looking online.
It works, but I'd like send the receipts when a condition is met.
cfws.Range("N"& I).Value = "no"
Do I start the If after I create the pdf files or after creating the Outlook object?
I tried several things but on most of my attempts, I get an error
Next without For.
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