I just did something like this, and since word mail merge is built as a
one to one replacement of data with fields, not repeating data, you
need to get a little tricky with VBA.
Basically, what I did was handle the MailMergeAfterRecordMerge and
MailMergeBeforeRecordMerge events in the mail merge document template.
In the MailMergeAfterRecordMerge I check the datasource values to see
if I need to add any values to a table, if I do, then I add those
values while getting the next record until I detect that I have come to
the next data element that needs to be merged. Below I've included the
full source code, it works great - oh, and you need to handle the
MailMergeBeforeRecordMerge because as you advance to the next element
in your datasource the damn thing will try and fire the merge even
though you are currently in the event to handle it!
' Global variables
Public WithEvents MailMergeApp As Word.Application
Public ActDoc As Document
Public NewDoc As Document
Public CancelMerge As Boolean
Private Sub MailMergeApp_MailMergeAfterRecordMerge(ByVal Doc As
Document)
Dim mergeDataTable As Table
Dim mergeData As MailMergeDataSource
Dim eventId As Integer
Dim nextEventId As Integer
Dim g As Integer
If ActDoc Is Nothing Then
For g = 1 To MailMergeApp.Documents.Count
If MailMergeApp.Documents(g).Name =
"ClientSummaryLetter.doc" Then
Set ActDoc = MailMergeApp.Documents(g)
End If
If MailMergeApp.Documents(g).Name <>
"ClientSummaryLetter.doc" And _
MailMergeApp.Documents(g).Name <> "mergedatasource.doc"
Then
Set NewDoc = MailMergeApp.Documents(g)
End If
Next
End If
For g = 1 To NewDoc.Tables.Count
If NewDoc.Tables(g).Rows.Count = 1 Then
Set mergeDataTable = NewDoc.Tables(g)
Exit For
End If
Next
Set mergeData = ActDoc.MailMerge.DataSource
eventId = CInt(ActDoc.MailMerge.DataSource.DataFields(8).Value)
nextEventId = CInt(ActDoc.MailMerge.DataSource.DataFields(8).Value)
CancelMerge = True
While eventId = nextEventId
newrow = mergeDataTable.Rows.Add()
mergeDataTable.Cell(mergeDataTable.Rows.Count,
1).Range.InsertAfter (mergeData.DataFields(9).Value)
mergeDataTable.Cell(mergeDataTable.Rows.Count,
2).Range.InsertAfter (mergeData.DataFields(10).Value)
mergeDataTable.Cell(mergeDataTable.Rows.Count,
3).Range.InsertAfter (mergeData.DataFields(11).Value)
mergeDataTable.Cell(mergeDataTable.Rows.Count,
4).Range.InsertAfter (mergeData.DataFields(12).Value)
ActDoc.MailMerge.DataSource.ActiveRecord = wdNextRecord
If IsNumeric(ActDoc.MailMerge.DataSource.DataFields(8).Value)
Then
nextEventId =
CInt(ActDoc.MailMerge.DataSource.DataFields(8).Value)
Else
Exit Sub
End If
Wend
CancelMerge = False
End Sub
Private Sub MailMergeApp_MailMergeBeforeRecordMerge(ByVal Doc As
Document, Cancel As Boolean)
If CancelMerge Then
Cancel = True
End If
End Sub
_Randal
