Hi, below is code to send a email (saved in outlook draft folder) to multiple addresses from an excel table. At the moment it is sending it in Rich Text format. What I would like to know is how could I modify the below code to send HTML emails instead of Rich Text?
Thanks in advance
Private Function GetRichTextTemplate() As String
Dim OLF As Outlook.MAPIFolder
Dim olMailItem As Outlook.MailItem
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)
Set oItems = OLF.Items
For Each Mailobject In oItems
If Mailobject.subject = "Template" Then
GetRichTextTemplate = Mailobject.HTMLBody
Exit Function
End If
Next
End Function
Public Sub SendMailMergeEmail()
Dim OLF As Outlook.MAPIFolder
Dim olMailItem As Outlook.MailItem
Dim olContact As Outlook.Recipient
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Dim subject As String
subject = "Template"
Dim body As String
Dim template As String
template = GetRichTextTemplate()
Dim cnumber As String
Dim cname As String
Dim email As String
Dim row As Integer
row = 2
cnumber = Sheets("Sheet1").Range("A" & row)
cname = Sheets("Sheet1").Range("B" & row)
email = Sheets("Sheet1").Range("C" & row)
While cnumber <> ""
Set olMailItem = OLF.Items.Add
With olMailItem
Set olContact = .Recipients.Add(email)
olContact.Resolve
.subject = subject
.BodyFormat = olFormatRichText
body = Replace(template, "{name}", cname)
body = Replace(body, "{number}", cnumber)
.HTMLBody = body
.Send
End With
row = row + 1
cnumber = Sheets("Sheet1").Range("A" & row)
cname = Sheets("Sheet1").Range("B" & row)
email = Sheets("Sheet1").Range("C" & row)
Wend
Set olContact = Nothing
Set olMailItem = Nothing
Set OLF = Nothing
End Sub
Bookmarks