I have code to send bulk emails to different recipients and with three attachments., when available.
When the macro does not find the PDF or Excel that it should attach, it doesn't send the mail.
I want to send the mail even if there are no attachments specified in the cell.
My code:
Sub Mail()
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(oMailItem)
Dim strMailBody As String
Dim Cel As Range
For Each Cel In Sheets("MS_Data").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
If Cel.Offset(0, 8).Value = "Y" Then ' "Y" or "y" - Case sensitive
Set objEmail = objOutlook.CreateItem(oMailItem)
StrMailSubject = ThisWorkbook.Sheets("Mail_Details").Range("A2").Text
strMailBody = "<BODY style='font-size:11pt;font-family:Calibri(Body)'>" & ThisWorkbook.Sheets("Mail_Details").Range("B2").Text & "</BODY>"
strMailBody = Replace(strMailBody, Chr(10), "<br>")
strFolder = "C:\Users\CIOTTIC\OneDrive - \Desktop\AL TEST"
strISO = Cel.Offset(0, 1).Value
strSalutation = Cel.Offset(0, 2).Value
strEmail = Cel.Offset(0, 3).Value
strCC = Cel.Offset(0, 4).Value
strFile = Cel.Offset(0, 5).Value
strFile2 = Cel.Offset(0, 6).Value
strFile3 = Cel.Offset(0, 7).Value
'
StrMailSubject = Replace(StrMailSubject, "<ISO>", strISO)
strMailBody = Replace(strMailBody, "<Salutation>", strSalutation)
With objEmail
.To = CStr(strEmail)
.CC = CStr(strCC)
.Subject = StrMailSubject
.BodyFormat = olFormatHTML
.Display
.Attachments.Add strFolder & "\" & strFile
.Attachments.Add strFolder & "\" & strFile2
.Attachments.Add strFolder & "\" & strFile3
.HTMLBody = strMailBody & .HTMLBody
.Send
End With
End If
Next Cel
MsgBox "Done"
End Sub
Thanking you in advance!
When the macro does not find the PDF or Excel that it should attach, it doesn't send the mail.
I want to send the mail even if there are no attachments specified in the cell.
My code:
Sub Mail()
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(oMailItem)
Dim strMailBody As String
Dim Cel As Range
For Each Cel In Sheets("MS_Data").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
If Cel.Offset(0, 8).Value = "Y" Then ' "Y" or "y" - Case sensitive
Set objEmail = objOutlook.CreateItem(oMailItem)
StrMailSubject = ThisWorkbook.Sheets("Mail_Details").Range("A2").Text
strMailBody = "<BODY style='font-size:11pt;font-family:Calibri(Body)'>" & ThisWorkbook.Sheets("Mail_Details").Range("B2").Text & "</BODY>"
strMailBody = Replace(strMailBody, Chr(10), "<br>")
strFolder = "C:\Users\CIOTTIC\OneDrive - \Desktop\AL TEST"
strISO = Cel.Offset(0, 1).Value
strSalutation = Cel.Offset(0, 2).Value
strEmail = Cel.Offset(0, 3).Value
strCC = Cel.Offset(0, 4).Value
strFile = Cel.Offset(0, 5).Value
strFile2 = Cel.Offset(0, 6).Value
strFile3 = Cel.Offset(0, 7).Value
'
StrMailSubject = Replace(StrMailSubject, "<ISO>", strISO)
strMailBody = Replace(strMailBody, "<Salutation>", strSalutation)
With objEmail
.To = CStr(strEmail)
.CC = CStr(strCC)
.Subject = StrMailSubject
.BodyFormat = olFormatHTML
.Display
.Attachments.Add strFolder & "\" & strFile
.Attachments.Add strFolder & "\" & strFile2
.Attachments.Add strFolder & "\" & strFile3
.HTMLBody = strMailBody & .HTMLBody
.Send
End With
End If
Next Cel
MsgBox "Done"
End Sub
Thanking you in advance!
