Update 1/21/2013: See Mail Merge in Word+Excel using VBA for even more mail merge code.
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 VBA 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:
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.
Optional: 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:
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 Object ' Word.Application Dim UserN As String Dim DesktopPath As String Application.ScreenUpdating = False ' get current username for directory UserN = Environ("username") ' get desktop path DesktopPath = Environ("userprofile") & "\Desktop\" ' 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 = DesktopPath & "Separated Workbooks" zz = DesktopPath & "Merged Word Docs" testzdir = Dir(z, vbDirectory) testzzdir = Dir(zz, vbDirectory) If testzdir = "" Then MkDir (DesktopPath & "Separated Workbooks") End If If testzzdir = "" Then MkDir (DesktopPath & "Merged Word Docs") End If End If ActiveWorkbook.SaveAs Filename:=DesktopPath & "Separated Workbooks\" & LocCode & ".xls", FileFormat:=xlNormal ActiveWorkbook.Close Next i Application.StatusBar = "Starting mail merge ..." FName = Dir(DesktopPath & "Separated Workbooks\*.xls") Do While Len(FName) > 0 If appWD Is Nothing Then Set appWD = CreateObject("Word.Application") ' New Word.Application End If appWD.Documents.Open Filename:=DesktopPath & "FormToMerge.doc" 'appWD.Visible = True With appWD.ActiveDocument.MailMerge .OpenDataSource Name:=DesktopPath & "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 (DesktopPath & "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: