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.