Mail Merge to E-mail with Attachments

Article contributed by Doug Robbins

This procedure can be used to mail merge to e-mail, including attachments with each message when Microsoft Office Outlook is installed. It has been tested with Office 97 and Office 2003 Beta 2. So it is assumed that it will work with all versions from Office 97 on. It is not necessary for Outlook to be nominated as the default mail program, but it must be installed on the system. The procedure can handle multiple attachments for each message, individual attachments for each recipient, common attachments for all recipients, or a mixture of both.

Preparations

To run the macro in this procedure it is necessary to set a reference to the Microsoft Office Outlook Object Library. You do this from within the Visual Basic Editor, by selecting References from the Tool menu and then checking the item Microsoft Office Outlook ##.0 Object Library (where ## is the Outlook version number).

In addition, running the macro will cause the following warning message to be displayed by Outlook for each email message that the macro sends:

You can avoid this happening by downloading the "Express ClickYes" utility that is available as a free download from:
http://www.contextmagic.com/express-clickyes/

Express ClickYes is a tiny program that sits in the taskbar and clicks the Yes button on behalf of you, when Outlook's Security Guard opens prompt dialog saying that a program is trying to send an email with Outlook or access its address book. You can suspend/resume it by double-clicking its taskbar icon. Developers can automate its behaviour by sending special messages.

Setup

You will need to create a separate Catalogue (or in Word 2002 and later, Directory) type mail merge main document which creates a word document containing a table in each row of which would be data from the data source that contains the email address in the first column and the Drive:\Path\Filename of each attachment in the second and any subsequent columns, one attachment per cell. That is:

If the same attachment(s) are to be sent to all of the recipients insert the Drive\Path\Filename of the attachment(s) into the Catalogue mail merge main document in place of the <<Attachment>> fields. In this case, your main document would look like:

You can also have a mixture of a standard attachment for each recipient and an individual one by setting the main document up in the following fashion:

You first execute that mail merge to a new document, which if you have set it up correctly will produce a document containing a table similar to the following:

Or in the case of a common attachment for each recipient:

Save that file and close it.

Then execute to a new document the mail merge that you want to send out by email with the attachments and with the result of execution of that mail merge on the screen, run a macro containing the following code.

Sub emailmergewithattachments()

Dim Source As Document, Maillist As Document

Dim Datarange As Range

Dim Counter As Integer, i As Integer

Dim bStarted As Boolean

Dim oOutlookApp As Outlook.Application

Dim oItem As Outlook.MailItem

Dim mysubject As String, message As String, title As String

Set Source = ActiveDocument

' Check if Outlook is running.  If it is not, start Outlook

On Error Resume Next

Set oOutlookApp = GetObject(, "Outlook.Application")

If Err <> 0 Then

    Set oOutlookApp = CreateObject("Outlook.Application")

    bStarted = True

End If

' Open the catalog mailmerge document

With Dialogs(wdDialogFileOpen)

    .Show

End With

Set Maillist = ActiveDocument

' Show an input box asking the user for the subject to be inserted into the email messages

message = "Enter the subject to be used for each email message."    ' Set prompt.

title = " Email Subject Input"    ' Set title.

' Display message, title

mysubject = InputBox(message, title)

' Iterate through the rows of the catalog mailmerge document, extracting the information

' to be included in each email.

Counter = 1

While Counter <= Maillist.Tables(1).Rows.Count

    Source.Sections.First.Range.Cut

    Documents.Add

    Selection.Paste

    Set oItem = oOutlookApp.CreateItem(olMailItem)

    With oItem

        .Subject = mysubject

        .Body = ActiveDocument.Content

        Set Datarange = Maillist.Tables(1).Cell(Counter, 1).Range

        Datarange.End = Datarange.End - 1

        .To = Datarange

        For i = 2 To Maillist.Tables(1).Columns.Count

            Set Datarange = Maillist.Tables(1).Cell(Counter, i).Range

            Datarange.End = Datarange.End - 1

            .Attachments.Add Trim(Datarange.Text), olByValue, 1

        Next i

        .Send

    End With

    Set oItem = Nothing

    ActiveDocument.Close wdDoNotSaveChanges

    Counter = Counter + 1

Wend

'  Close Outlook if it was started by this macro.

If bStarted Then

    oOutlookApp.Quit

End If

'Clean up

Set oOutlookApp = Nothing

Source.Close wdDoNotSaveChanges

Maillist.Close wdDoNotSaveChanges

End Sub