Send personalised emails from Excel with Outlook and VBA

Sending the same email to a list of clients, each with their own name and attachment, is one of the most common requests I get. Word mail merge can do part of it, but attachments and tracking who has already been emailed get messy fast. A few lines of VBA in Excel handle the whole job.

How the sheet is laid out

Create a sheet called Mailing with these headers in row 1:

• A Name
• B Email
• C Subject
• D Message (write {Name} where the name should go)
• E Attachment path, optional
• F Status, filled in by the macro

The macro

Option Explicit

' Outlook mail merge from Excel
' Free module from sourabsaha.com
'
' Sheet "Mailing", headers in row 1:
'   A Name | B Email | C Subject | D Message | E Attachment path (optional) | F Status
' Write {Name} anywhere in the message to insert the person's name.
' Keep SendNow = False to review drafts first, then set it to True.

Private Const SendNow As Boolean = False

Public Sub SendMailMerge()
    Dim ws As Worksheet
    Dim olApp As Object, olMail As Object
    Dim lastRow As Long, r As Long, done As Long
    Dim attachPath As String

    Set ws = ThisWorkbook.Worksheets("Mailing")
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    If lastRow < 2 Then
        MsgBox "Add at least one email address in column B.", vbExclamation
        Exit Sub
    End If

    Set olApp = CreateObject("Outlook.Application")

    For r = 2 To lastRow
        If Len(ws.Cells(r, "B").Value) > 0 And ws.Cells(r, "F").Value <> "Sent" Then
            Set olMail = olApp.CreateItem(0)
            With olMail
                .To = ws.Cells(r, "B").Value
                .Subject = ws.Cells(r, "C").Value
                .Body = Replace(ws.Cells(r, "D").Value, "{Name}", ws.Cells(r, "A").Value)
                attachPath = Trim$(ws.Cells(r, "E").Value)
                If Len(attachPath) > 0 Then
                    If Len(Dir(attachPath)) > 0 Then .Attachments.Add attachPath
                End If
                If SendNow Then .Send Else .Display
            End With
            ws.Cells(r, "F").Value = IIf(SendNow, "Sent", "Draft opened")
            done = done + 1
            Set olMail = Nothing
        End If
    Next r

    Set olApp = Nothing
    MsgBox done & " email(s) processed.", vbInformation
End Sub

How it works

• Rows already marked Sent are skipped, so you can run it again safely after adding new rows.
• With SendNow = False each email opens as a draft for you to check. Switch it to True once you are happy.
• It uses late binding (CreateObject), so you do not need to add the Outlook reference library.

Free download

Download the module and import it into your own workbook:

Download Outlook-Mail-Merge.bas

1. Open your workbook and press Alt + F11 to open the VBA editor.
2. Choose File, Import File and pick the downloaded .bas file.
3. Save the workbook as Excel Macro-Enabled Workbook (.xlsm).
4. Run the macro from Developer, Macros, or assign it to a button.

Need HTML emails, a different sender account or a schedule? Send me a message and I can extend it for you.