Let's start with an Excel spreadsheet which looks like the following figure. There are three fields which will be used to customize each email. Of course, the most important field is the email address itself which will be used to determine the recipient.
Next, we suppose that the following email template have been created and saved in the Drafts folder of Outlook. The Subject: must be called "Template" because this is the string which the macro will lookfor.
Notice the placeholders {name} and {number}. These placeholders will be replaced by the actual values drawn from each record in the spreadsheet illustrated earlier.
Here's the coding part. Let start by defining a macro to load the email template from the Drafts folder in Outlook. Basically, this macro iterates each item in the Drafts folder to find the template which is the one with its subject as "Template". Line 11 is the trick to get the job done. The formatted template is retrieved and is returned from this function hence eliminating the need to code the body of the email programmatically.
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
Next, we need to define the macro SendMailMergeEmail to generate the customized emails and to send them out. There are a few things this macro do. First, it uses the GetRichTextTemplate macro to get the template from the Drafts folder. Then for each record in the spreadsheet, it will retrieve the values and place them into the placeholders. And then, it will put in the subject and the recipient before sending out the email.
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 = " Latest Product Update"
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("Main").Range("A" & row)
cname = Sheets("Main").Range("B" & row)
email = Sheets("Main").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("Main").Range("A" & row)
cname = Sheets("Main").Range("B" & row)
email = Sheets("Main").Range("C" & row)
Wend
Set olContact = Nothing
Set olMailItem = Nothing
Set OLF = Nothing
End Sub
One more thing. For the codes above to run, the reference for Microsoft Outlook 14.0 Object Library has to be set. If you are not using the latest Office 2010, you could select Microsoft Outlook Object 12.0 Library for Office 2007.
The above dialog box can be accessed from the Excel VBA Window under Tools...References. After adding the reference, you are now ready to execute the macro SendMailMergeEmail to send customised rich text emails. Here is a sample of the generated email that was sent.
You can see that the number, customer name and email have been mail-merged into the template. By the way, you can find all sent emails in the Outlook's Sent Items folder.
The codes have been tested using Excel and Outlook 2010. You can download the Excel File here. Hope you have enjoyed this post and find the example useful.
