Gember Design

I recently assisted someone with a mail-merge in Microsoft Word 2007 for a letter whose content depended on a person’s interests. I started with three different components (all in the same directory):

1. An Excel spreadsheet containing the name, address, and area of interest for everyone who should receive the letter.
2. A Word document with the top of the letter (date, address block, and greeting).
3. Word documents with a different letter body and signature for each area of interest. The documents were each named for the area of interest as stored in the spreadsheet.

In the Word document containing the top of the letter, I setup a mail-merge. The source data was the Excel spreadsheet. I inserted the necessary merge fields for the top of the letter. I also inserted the area of interest field surrounded by four equal signs (=) in the place where the body should go.

====<<Area_Of_Interest>>====

In the same document I wrote a macro to do the following:

1. Complete the merge to a new document
2. Find the first occurrence of ====*==== in the document, where * was a wild card for the area of interest
3. Remove the equal signs and area of interest
4. Insert one of the body and signature Word documents using the area of interest to determine the file name
5. Go back to step #2 and repeat until no more occurrences of ====*==== exist

In the end, I had each letter with the appropriate address block, greeting, and letter body based on the data in the Excel spreadsheet. Below is the VBA code for the macro.

Sub InsertLetter()
Dim dept
Dim aRange
Dim done
Dim filename

'Execute mail merge
With ActiveDocument.MailMerge
    .Destination = wdSendToNewDocument
    .Execute
End With

'Search entire document for special tags
done = False
Selection.SetRange ActiveDocument.Range.Start, ActiveDocument.Range.End

'Continue searching document until no more tags are found
Do While (Not done)
    'Execute search
    With Selection.Find
        .Text = "====*===="
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute

    'If tag is found, get value of tag
    If (Selection.Find.Found) Then
        dept = ActiveWindow.ActivePane.Selection
        dept = Left(dept, Len(dept) - 4)
        dept = Right(dept, Len(dept) - 4)
        filename = dept + ".doc"

        'Verify document to insert (replacing tag) exists and insert
        If (Dir(filename) <> "") Then
            ActiveWindow.ActivePane.Selection = ""
            Set aRange = ActiveWindow.ActivePane.Selection
            aRange.Start = aRange.End
            aRange.InsertFile filename:=filename
            'Display and put error message in document if file does not exist
        Else
            MsgBox "No letter found for department: " + dept, vbExclamation
            ActiveWindow.ActivePane.Selection = "No letter found for department: " _
                + dept
        End If

        'Update search range to search the rest of the document
        Selection.SetRange Selection.End, ActiveDocument.Range.End
    Else
        done = True
    End If
Loop
End Sub

Development microsoft word 2007