Great new way to Mail merge one-to-many records fails at final hurdle...

Dear experts,

I have created a mail merge template that merges with a recordsource. In the template, I have created an event procedure for the "MailMergeAfterRecordMerge" event, that fires for each record when merged. This is a new feature since Word 2002. But it seems to go by largely undiscovered, as Google still only gives 41 hits on this event's name! Anyway, in this event procedure one could open an Access database to fetch the 'many' records from a couple of 'one-to-many' tables where the 'one' records are the mailmerge recordsource. This lets one create personalized invoices with separate purchases neatly in rows.

I want to create such a document and automate the procedure, so the Word template is instructed to start merging right away when a new document is based upon it.

But now comes the final hurdle that keeps throwing me off balance:

If I use the above event procedure to insert a many-side table into each merged record, only one record gets merged.
If I use the above event procedure to add anything else from the many-side to each record, all the records get merged.
If I manually click the "merge to new document" button in the toolbar, I can insert tables in each merged record and all records get merged (so I know it actually does work!).

My 500 point question is logical: who can help me automate this procedure, so I can mail merge all records and insert many-side tables in each one-side record.

For those of you who are still with me (hang in there!), here are the steps to reproduce my problem:

1) Create a Word template in Word 2002 (or higher) and call it MailMerge.dot
2) Create a mailmerge recordsource file with two or so records and call it MailMerge.txt
3) Put both files in the same directory
4) Tell MailMerge.dot that it's supposed to merge with MailMerge.txt
5) Put some mailmerge fields anywhere you want
6) Put the following text somewhere: Put_Table_Here (the code looks for that string to insert data when merging)
7) Open the VBA window (Alt-F11)
8) Select the "ThisDocument" thingie (what are those called anyway?) on the left hand side.
9) Paste the code below on the right hand side.
10) Save and close MailMerge.dot
11) From the File Explorer (or however you go about this yourself) right click mailmerge.dot and choose New
12) All records ought to merge automatically now
13) Close everything, and re-open MailMerge.dot for editing
14) Open the VBA window and unblock (or un-comment or whatever it's called) the line where it says: Selection.Tables.Add (I think it's the very last line)
15) Save and close and repeat step 11
16) Only one record merges
17) Close (and don't save) the new document containing the one merged record
18) You will have a "Document1" (or something like that) still open.
19) Click the "Mailmerge to new document" button yourself
20) All records merge
21) Have some coffee and come up with an elegant solution
22) Earn 500 house points.

I hope you can help me with this one!

Kind regards,
Keimpe


[code]Private WithEvents oApp As Word.Application

Private Sub Document_New()
  If oApp Is Nothing Then Set oApp = ThisDocument.Application
    ActiveDocument.MailMerge.OpenDataSource ThisDocument.Path & "\MailMerge.txt"
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
End Sub


Private Sub Document_Open()
    If oApp Is Nothing Then Set oApp = ThisDocument.Application
End Sub

Private Sub oApp_MailMergeBeforeRecordMerge(ByVal Doc As Document, Cancel As Boolean)
    MsgBox "Before record merge"
End Sub


Private Sub oApp_MailMergeAfterRecordMerge(ByVal Doc As Document)
   
    MsgBox "After record merge"
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Put_Table_Here"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.TypeText "You can put anything here..."
    'Selection.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _
    2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
    wdAutoFitWindow

End Sub[/code]