Hi All,
I am trying to add images in the email body in my mass email macro but unfortunately, I have no success as of yet.
So in my excel, I have the HTML images links for different emails in the "column L". For each recipient, the image could be different. I accordingly paste the path
For example - D:\Apps\xp\Desktop\Doc1.htm
Please see my code below, could any one please help me with the code on how to embed image in the email body.
I need to add the image after the email.
I am trying to add images in the email body in my mass email macro but unfortunately, I have no success as of yet.
So in my excel, I have the HTML images links for different emails in the "column L". For each recipient, the image could be different. I accordingly paste the path
For example - D:\Apps\xp\Desktop\Doc1.htm
Please see my code below, could any one please help me with the code on how to embed image in the email body.
I need to add the image after the email.
Code:
Sub togenerateemails()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim rng As Range
Dim strbody As String
Dim pic As String
Dim Hlink As String, Hlink2 As String
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
'Windows("master.xlsx").Activate
'Worksheets("Sheet2").Activate
Sheets("to create emails").Activate
'Worksheets("Current report").Activate
For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "g").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.SentOnBehalfOfName = "Aman"
.To = Cells(cell.Row, "e").Value
.cc = Cells(cell.Row, "h").Value
.Attachments.Add (Cells(cell.Row, "K").Value)
If Cells(cell.Row, "D") = "False" Then
.Subject = "Accounts"
body = "Dear " & Cells(cell.Row, "F").Value & "," & "" _
& vbNewLine & vbNewLine & _
"<p><font face=""Calibri"" size=""2"" color=""black"">"EMAIL BODY " </A>. </P>" _
.HTMLBody = body
ElseIf Cells(cell.Row, "D") = "True" Then
.Subject = " Accounts"
body = "Dear " & Cells(cell.Row, "F").Value & "," & "" _
& vbNewLine & vbNewLine & _
"<p><font face=""Calibri"" size=""2"" color=""black"">"EMAIL BODY " </A>. </P>" _
.HTMLBody = body
End If
.Display
'(Remove the line below if the email has to be reviewed first before sending'
'SendKeys "^{ENTER}"
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
MsgBox ("All the emails have been drafted")
End Sub
Last edited:
