Excel VBA Macro: Send Multiple Emails (with Multiple Attachments)
Excel VBA Macro: Send Multiple Emails (with Multiple Attachments)
Code (YouTube doesn't allow brackets; so LT and GT are used for less than and greater than, respectively):
Sub multi_emails_attachments()
Dim OutApp As Object
Dim OutMail As Object
Dim ws As Worksheet
Dim strbody As String
Dim row_count As Integer
Dim col_count As Integer
Dim i As Integer
Dim j As Integer
Set ws = ThisWorkbook.Sheets("Emails")
ws.Activate
row_count = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))
col_count = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlToRight)))
For i = 2 To row_count
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "LT BODY style = font-size:12pt, font-familt:Arial GT" & _
"Hi Team, LT p GT Please see file(s) attached. LT p GT" & _
"Thanks, LT br GT Greg"
On Error Resume Next
With OutMail
.to = ws.Cells(i, 1).Text
.CC = ""
.BCC = ""
.Subject = ws.Cells(i, 2).Text
.Display
.HTMLBody = strbody & .HTMLBody
For j = 3 To col_count
.attachments.Add ws.Cells(i, j).Text
Next j
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Next i
End Sub
#excelvba #excelmacro
