' 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
--
Hope this helps.
Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.
Doug Robbins - Word MVP
