Replace specific word inside a table in the Header with Merge field
Hi,
I'm trying to replace hardcoded addresses in a table inside the header with mailmerge fields
e.g.
1 Spring Avenue
Springarea
Springtown
Springfield TT4 77S
With
{MERGEFIELD Address_line1}
{MERGEFIELD Address_line2}
{MERGEFIELD Address_line3}
{MERGEFIELD Address_line4} {MERGEFIELD Address_PostCode}
The same address appears elsewhere like in main area or footer but only the address in the header should be replaced
I have tried
Sub replace()
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="Springtown")
oRng.Fields.Add oRng, wdFieldMergeField, "Address_line1", False
oRng.Collapse wdCollapseEnd
Loop
End With
End Sub
Sub replace2()
Dim oRng As Range
Dim hf As Word.HeaderFooter
Dim tableCount As Integer
Dim t As Integer
Dim c As Cell
Set oRng = ActiveDocument.Range
For Each hf In oRng.Sections(1).Headers()
tableCount = hf.Range.Tables.Count
For t = 1 To tableCount
For Each c In hf.Range.Tables(t).Range.Cells
Debug.Print c.Range.Text
With c.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Colchester"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
If .Find.Found = True Then
.Fields.Add .Range, wdFieldEmpty, "MERGEFIELD Address_line1", False
End If
Next c
Next t
Next hf
End Sub
Sub replace3()
Dim oRng As Range
Dim hf As Word.HeaderFooter
Dim tableCount As Integer
Dim t As Integer
Dim c As Cell
For Each hf In ActiveDocument.Sections(1).Headers
With hf.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Springtown"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
If .Find.Found = True Then
.Fields.Add .Range, wdFieldEmpty, "MERGEFIELD Address_line1", False
End If
End With
Next
End Sub
But i am not having much luck - any ideas
Thanks
|