[Peter Jamieson]

Do you know of a way to have it run automatically for each
merged document? Right now I'm having to run it manually (which is still a
step forward, at least).

I would probably create a macro that perforrmed the merge /then/ did the
find/replace. e.g.

Sub MergeThenReplace()
Dim objMMMD As Word.Document 'Mail Merge Main Document

' After the merge, the new document becomes the active document
' So make a reference to the activeDocument in case we
' need to refer to it post-merge (although in this case, we don't)

Set objMMMD = ActiveDocument

With objMMMD.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With

With ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Style = ActiveDocument.Styles("Heading 3")
.Replacement.ParagraphFormat.Borders.Shadow = False
.Text = "\h3\(*)\/h3\"
.Replacement.Text = "\1"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With

Set objMMMD = Nothing

End Sub

Peter Jamieson


"Brendan" wrote in message
...
Hi Peter,

Thanks again. You've been a great help.

I recorded the following macro and tested running it on merged documents.
It
works nicely. Do you know of a way to have it run automatically for each
merged document? Right now I'm having to run it manually (which is still a
step forward, at least).

Sub StyleReplace()
'
' StyleReplace Macro
' Macro recorded 5/3/2007 by Brendan
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Replacement.ParagraphFormat.Borders .Shadow = False
With Selection.Find
.Text = "\h3\(*)\/h3\"
.Replacement.Text = "\1"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub