Automated Mail Merge to Word from Excel

If you ever wanted to automate the process of mail merging a Word document with information from an Excel spreadsheet, here is an example that might help.

This code takes a sample spreadsheet with a list of contact names/addresses, separates each into a separate workbook based on information in column D, and saves them all to a folder. Then it mail merges each workbook to a Word doc that is already set up with matching merge fields, and saves each individualized Word doc to a separate folder.

Download the samples here if you want to follow along (right-click, choose "Save Target As"):

Sample Spreadsheet
Sample Word doc for merge

For this example, we assume that column D contains a site code which distinguishes each row (i.e. a region name, business unit, etc). In this example, it is a region name. Keep in mind you don't need to do it this way; since each row(record) is getting its own workbook, you could just as easily insert a blank row between every row (except between the header row and the first data row), without regard for what is in any particular column. For this example I wanted to demonstrate this "intelligent" technique of separating data into groups, because it can be used in many other applications. As usual, there should be no blank rows or columns separating your data.

The first thing you want to do before you test this macro is link your Word doc to the spreadsheet by going to View>Toolbars>Mail Merge, or right-clicking on any existing toolbar and selecting "Mail Merge". Click the "Open Data Source" button and browse to the sample spreadsheet. Press OK when you get to this dialog box:

At this point you should insert the merge fields into your document as I did in the sample. And of course be sure you customize the document as you want it to be seen by the recipient. My sample is very basic but you can make your document as complicated as you wish.

The first thing we do in the macro is separate each row into separate workbooks, so each one can be merged into its own Word doc. The way we do that is by looping through column D (backwards) and inserting a blank row when the region changes. Then we paste in the header row in the empty rows, because each workbook will need a header row for mail merge. We repeat the loop to insert blank rows again, then save each "area" to a separate workbook. We name each range with the same name to make it much easier to mail merge.

Then we instantiate MS Word, open our document, and loop through the folder with the workbooks, merging each one into the Word doc and saving to a new file name in a new folder.

Remember to set a reference to the Word object library (see the Binding page for help setting up references to object libraries). Of course I do make some basic assumptions in the code (for example, that Windows is located on the C: drive on your computer) so please visually inspect the code first (and Debug>Compile, and F8-Step Into) and adjust as necessary before running unattended.

Place the following code in a standard module.

Option Explicit

Sub MailMergeandSave()
Dim AreasCount As Integer
Dim LocCode As String
Dim Rng As Excel.Range, Col As Integer
Dim X As Integer, r As Integer, i As Integer, z As String, zz As String
Dim NewWB As Excel.Workbook
Dim testzdir As String, FName As String, testzzdir As String
Dim appWD As Word.Application
Dim UserN As String

Application.ScreenUpdating = False
' get current username for directory
UserN = Environ("username")

' split the ranges to insert headers
Set Rng = ActiveSheet.UsedRange.Rows
Col = Range("D:D").Column
X = Rng.Rows.count
For r = X - 1 To 2 Step -1
    Application.StatusBar = "Splitting row " & (X - r) & " of " & X
    If Cells(r, Col) <> Cells(r + 1, Col) Then
        Cells(r + 1, Col).EntireRow.Insert
    End If
Next r

' paste in header rows above each section of data
Cells(1, 1).Select
Range(Selection, Selection.End(xlToRight)).Copy
Range(Cells(1, 1), Cells(Rng.Rows.count, Rng.Columns.count)).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
ActiveSheet.Paste

' split again with headers
Set Rng = ActiveSheet.UsedRange.Rows
Col = Range("D:D").Column
X = Rng.Rows.count
For r = X - 1 To 2 Step -1
    Application.StatusBar = "Splitting row " & (X - r) & " of " & X
    If Cells(r, Col) = Cells(1, 4).Value Then
        Cells(r, Col).EntireRow.Insert
    End If
Next r

' create a new workbook for each location
Cells.Select
Selection.SpecialCells(xlCellTypeConstants, 23).Select
AreasCount = Selection.Areas.count
    For i = 1 To AreasCount
      Application.StatusBar = "Now processing section " & i & " of " & AreasCount
        If i > 1 Then
            Cells.Select
            Selection.SpecialCells(xlCellTypeConstants, 23).Select
        End If
                Selection.Areas(i).Select
        LocCode = Selection.Cells(2, 4).Value
        Selection.Copy
        Set NewWB = Workbooks.Add
        ActiveSheet.Paste
        'Selection.Columns.AutoFit
        Selection.Name = "listing"
                If i = 1 Then
            z = "C:\Documents And Settings\" & UserN & "\Desktop\Separated Workbooks"
            zz = "C:\Documents And Settings\" & UserN & "\Desktop\Merged Word Docs"
            testzdir = Dir(z, vbDirectory)
            testzzdir = Dir(zz, vbDirectory)
                If testzdir = "" Then
                    MkDir ("C:\Documents And Settings\" & UserN & _
"\Desktop\Separated Workbooks")
                End If
                If testzzdir = "" Then
                    MkDir ("C:\Documents And Settings\" & UserN & _
"\Desktop\Merged Word Docs")
                End If
        End If

        ActiveWorkbook.SaveAs Filename:="C:\Documents And Settings\" & UserN & _
"\Desktop\Separated Workbooks\" & LocCode & ".xls", FileFormat:=xlNormal
        ActiveWorkbook.Close
    Next i

Application.StatusBar = "Starting mail merge ..."

FName = Dir("C:\Documents And Settings\" & UserN & "\Desktop\Separated Workbooks\*.xls")

Do While Len(FName) > 0
If appWD Is Nothing Then
    Set appWD = CreateObject("Word.Application")
End If
    appWD.Documents.Open Filename:="C:\Documents And Settings\" & UserN & _
"\Desktop\FormToMerge.doc"
    'appWD.Visible = True
        With appWD.ActiveDocument.MailMerge
        .OpenDataSource Name:="C:\Documents And Settings\" & UserN & _
 "\Desktop\Separated Workbooks\" & FName, SQLStatement:="SELECT * FROM [listing]"
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        .Execute Pause:=False
    End With

Application.StatusBar = "Now creating document for " & Left(FName, Len(FName) - 4)

        ActiveDocument.SaveAs ("C:\Documents And Settings\" & UserN & _
 "\Desktop\Merged Word Docs\" & Left(FName, Len(FName) - 4)), FileFormat:=wdFormatDocument
        ActiveDocument.Close

appWD.Documents("FormToMerge.doc").Close savechanges:=False

    FName = Dir
Loop

appWD.Quit
Set appWD = Nothing
Set Rng = Nothing
Set NewWB = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True

End Sub

Let's walk through the code to see what it is doing. As I mentioned above, we insert a blank row between each row, then insert the header row into these blank rows. We repeat the loop to insert blank rows again, this time above each header row, then save each "area" to a separate workbook. We create two folders on the desktop, one to hold the separate workbooks, and another for the merged documents which will be created shortly.

I used the Dir function to loop through the folder and pick up each successive workbook name. We open the Word document, and perform the merge using the .OpenDataSource method. If you recall from above, this is how we originally linked the Word doc to the original spreadsheet, so the code syntax follows the GUI quite nicely (or vice versa).

Notice the SQL statement used for the merge. We used the word 'listing' to name the range, and since we separated each row onto its own workbook before naming the range, we are able to use this stock code for every single merge! If we named the ranges before copying to a new workbook, we could not use the same word, so in the merge portion of the code we would need to use a complicated loop to figure out which file we were working on and change the range name accordingly! Because we copied to a new workbook before naming the range, we avoid all that.

I use the file name from the spreadsheet (originally from the region name) to name the newly merged Word doc. Notice that I have to use Left and Len functions to extract the file name, because spreadsheets have a .XLS extension which we surely don't want to use for a Word doc!

Lastly, we save the newly created document to the folder we created earlier.

Please note some of this code is a bit old and isn't how I would do this today, this is just for demonstration purposes. For example, I select the constant cells in the original worksheet, where normally I would define a range object consisting of only the constant cells. This would make the resulting code somewhat faster because you aren't selecting cells before acting on them. Also I open/close the same Word doc four times.

A sample workbook and Word doc to test out this code are located here (right-click, choose "Save Target As"):

Sample Spreadsheet
Sample Word doc for merge

Automated Mail Merge to Word from Excel

LAST UPDATED: March 29, 2008