Question : Mail Merge: Data across multiple rows

Hi all,

As part of a recent project I need to mail merge multiple rows of data into a table in a Word Document, and I'm struggling to find a way to go about doing this.

I've attached examples of the documents our systems are producing. One is an Excel file showing the raw data outputted from a much more complex project monitoring and tracking system. The other is a Word Document which shows how this data would (ideally) be merged to produce meaningful output for us. (I've only shown the first employee per the excel spreadsheet; clearly the word output would also have a page break then move onto the next employee and their requirements per the excel document)

The examples are simplified for ease of use (there will be much more data to work with in the final edition) but I'm really looking for a hand to point me in the right direction. I've absolutely no knowledge of Word VBA (although I do use Excel VBA almost daily - it can't be too different, can it?).

The main issue with the merge is there may be a different number of requirements listed for each person, so the table in the merged output needs to resize to accommodate the different number of rows (without screwing the formatting up).

If someone could lend me a hand here, I would sincerely appreciate it. Please do not post only links to other solutions at EE or elsewhere, as I've searched extensively but cannot muddle my way through this (although by all means use links as part of your answer).

Note: Although I don't have control over the actual tracking system, I can* change the output format for the raw Excel data book used for the merge.

Thanks for any and all help you can offer!

Matt

Answer : Mail Merge: Data across multiple rows

This Excel VBA snippet requires a Word template.

Bookmark the name positions in the document as Fullname and Firstname. Delete all but the first row in the table, and save the document as a template. The code uses early binding, so needs a reference to the Microsoft Word Object library.

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:

           
           
             Option Explicit
 
Sub DoMerge()
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim sh As Worksheet
    Dim strEmployee As String
    Dim r As Integer
    Dim rw As Word.Row
    
    Set sh = ActiveSheet
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    r = 1
    Do
        If sh.Cells(r, 1).Value <> "" Then
            If strEmployee <> "" Then
                wdDoc.SaveAs "C:\MyFolder\" & strEmployee & ".doc"
                wdDoc.Close wdDoNotSaveChanges
            End If
            Set wdDoc = wdApp.Documents.Add("C:\MyTemplatePath\SampleLetterEmployee.dot")
            strEmployee = sh.Cells(r, 1).Value & " " & sh.Cells(r, 2).Value
            wdDoc.Bookmarks("Fullname").Range.Text = strEmployee
            wdDoc.Bookmarks("Firstname").Range.Text = sh.Cells(r, 1).Value
        End If
        Set rw = wdDoc.Tables(1).Rows.Add
        rw.Range.Bold = False
        rw.Cells(1).Range.Text = sh.Cells(r, 3).Value
        rw.Cells(2).Range.Text = sh.Cells(r, 4).Value
        r = r + 1
    Loop Until sh.Cells(r, 3).Value = ""
    wdDoc.SaveAs "C:\MyFolder\" & strEmployee & ".doc"
    wdDoc.Close wdDoNotSaveChanges
End Sub
           
         

Open in New Window

Select All