Bookmarks must be unique, the very nature of merge would require the same
bookmarks for each record, so they are stripped from the merge.

' Throwaway Macro created by Doug Robbins to "preserve" bookmarks during a
MailMerge
'
Dim abm As Bookmark, bmrange As Range, i As Long, Result As Document, j As
Long, k As Long, linkrange As Range, linktarget As String
Dim Source As Document
Set Source = ActiveDocument
i = 1
For j = 1 To Source.MailMerge.DataSource.RecordCount
   For Each abm In ActiveDocument.Range.Bookmarks
       System.PrivateProfileString("c:\bookmarks.txt", "bookmarkNames",
"bookmark" & i) = abm.Name & Format(j)
       i = i + 1
   Next
Next j
For Each abm In ActiveDocument.Range.Bookmarks
   abm.Range.InsertBefore "#"
   abm.Range.InsertAfter "#"
Next
With ActiveDocument.MailMerge
   .Destination = wdSendToNewDocument
   .Execute
End With
Set Result = ActiveDocument
k = 1
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
   Do While .Execute(FindText:="#*#", MatchWildcards:=True,
Wrap:=wdFindContinue, Forward:=True) = True
       Set bmrange = Selection.Range
       bmrange.Characters(bmrange.Characters.Count).Delete
       bmrange.Characters(1).Delete
       Result.Bookmarks.Add System.PrivateProfileString("c:\bookmarks.txt",
"bookmarkNames", "bookmark" & k), bmrange
       k = k + 1
   Loop
End With
For i = 1 To Result.Hyperlinks.Count
   linktarget = Result.Hyperlinks(i).SubAddress
   Set linkrange = Result.Hyperlinks(i).Range
   linkrange.Select
   linktarget = linktarget &
Format(Selection.Information(wdActiveEndSectionNumber))
   Result.Hyperlinks.Add Result.Hyperlinks(i).Range, "", linktarget
Next i

Source.Activate
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
   Do While .Execute(FindText:="#*#", MatchWildcards:=True,
Wrap:=wdFindContinue, Forward:=True) = True
       Set bmrange = Selection.Range
       bmrange.Characters(bmrange.Characters.Count).Delete
       bmrange.Characters(1).Delete
   Loop
End With