finding text wherever it appears in a word document

[Andy Fish]

Hi,

I have an application where I want to be able to find and/or replace text
wherever it appears in a Word document (including in headers, footnotes
etc). This is a fairly common problem and a bit of research has led me to
this page:

http://word.mvps.org/FAQs/Customization/ReplaceAnywhere.htm

which I believe to be the current state of the art.

However, this solution will not find text within a text box which is itself
within a header or footer (there may be other limitations as well but this
is the one I specifically came across).

Does anyone know of an algorithm for search and replace which will even find
text in textboxes within headers and footers?

If it cannot be done from VBA or OLE at all, is there any other mechanism I
can use to effect this?

TIA

Andy

 

[Jonathan West]

Hi Andy,

Within each StoryRange as found by the ReplaceAnywhere macro, you can test
for whether its ShapeRange.Count property is greater than 0.

If it is, you can iterate through each Shape in the ShapeRange collection
and see if its TextFrame.HasText property is True. If it is, then the
Shape's TextFrame.TextRange property is a Range object which you can search
for text you want to replace.

--
Regards
Jonathan West - Word MVP
www.intelligentdocuments.co.uk
Please reply to the newsgroup
Keep your VBA code safe, sign the ClassicVB petition www.classicvb.org

 

[Greg]

Jonathan,

I noticed that a normal find and replace also misses text in a textbox
located in a header.

After looking at your tip to Andy, I attempted the following which
appears to be a more comprehensive "find and replace anywhere" macro.
Would you please look at it an comment on where improvements could be
made:

Public Sub FindReplaceAnywhereWithVBA()
Dim rngstory As Word.Range
Dim findText As String
Dim Replacement As String
Dim pJunk As Long

findText = "test find"
Replacement = "test replaced"
'Fix the skipped blank Header/Footer problem
pJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
'Iterate through all story types in the current document
For Each rngstory In ActiveDocument.StoryRanges
SrchAndReplInStory rngstory, findText, Replacement
On Error Resume Next
If rngstory.ShapeRange.Count > 0 Then
Dim oShp As Shape
For Each oShp In rngstory.ShapeRange
If oShp.TextFrame.HasText Then
SrchAndReplInStory oShp.TextFrame.TextRange, findText,
Replacement
End If
Next
End If
On Error GoTo 0
Next
End Sub

Public Sub SrchAndReplInStory(ByVal rngstory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
Do Until (rngstory Is Nothing)
With rngstory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.Replacement.Font.Color = wdColorBlue
.Execute Replace:=wdReplaceAll
End With
Set rngstory = rngstory.NextStoryRange
Loop
End Sub

 

[Greg]

Jonathan (and all others)

Please disregard the earlier reply. Seems that version only worked for
the header/footer in first section.

I have moved the addtional code in the actual search routine and it
appears to work now in all headers, including headers that are not
linked to a previous header:

Public Sub FindReplaceWithVBA()

Dim rngStory As Word.Range
Dim pFindTxt As String
Dim pReplaceText As String
Dim lngJunk As Long

pFindTxt = InputBox("Enter the text that you want to find then
replace.", "Batch Replace Anywhere")
If pFindTxt = "" Then
MsgBox "Cancelled by User"
Exit Sub
End If
Tryagain:
pReplaceText = InputBox("Enter the pReplaceText text.", "Replace
Anywhere ")
If pReplaceText = "" Then
If MsgBox("Do you just want to delete the found text?",
vbYesNoCancel) = vbNo Then
GoTo Tryagain
ElseIf vbCancel Then
MsgBox "Cancelled by User."
Exit Sub
End If
End If
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
SearchAndReplaceInStory rngStory, pFindTxt, pReplaceText
Next
End Sub
Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
Dim oShp As Shape
ResetFRParameters
'This routine supplied by Peter Hewett
Do Until (rngStory Is Nothing)
With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.Execute Replace:=wdReplaceAll
End With
On Error Resume Next
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If oShp.TextFrame.HasText Then
With oShp.TextFrame.TextRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.Execute Replace:=wdReplaceAll
End With
End If
Next
End If
On Error GoTo 0
Set rngStory = rngStory.NextStoryRange
Loop
End Sub

 

[Greg]

Jonathan (and others)

Sorry for being troublesome. I think I have managed to make this a bit
more presentable:

Public Sub FindReplaceAnywhere()
Dim rngStory As Word.Range
Dim pFindTxt As String
Dim pReplaceTxt As String
Dim lngJunk As Long
Dim oShp As Shape

pFindTxt = InputBox("Enter the text that you want to find.", _
"FIND")
If pFindTxt = "" Then
MsgBox "Cancelled by User"
Exit Sub
End If
Tryagain:
pReplaceTxt = InputBox("Enter the replacement.", "REPLACE")
If pReplaceTxt = "" Then
If MsgBox("Do you just want to delete the found text?",
vbYesNoCancel) = vbNo Then
GoTo Tryagain
ElseIf vbCancel Then
MsgBox "Cancelled by User."
Exit Sub
End If
End If
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
ResetFRParameters
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
On Error Resume Next
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If oShp.TextFrame.HasText Then
SearchAndReplaceInStory oShp.TextFrame.TextRange, _
pFindTxt, pReplaceTxt
End If
Next
End If
On Error GoTo 0
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
End Sub
Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.Execute Replace:=wdReplaceAll
End With
End Sub
Sub ResetFRParameters()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub

 

[Andy Fish]

Thanks for your help on this Greg.

The word object model is not my strong point so this will be really useful
to me

Andy

Jonathan (and others)

Sorry for being troublesome. I think I have managed to make this a bit
more presentable:

<snip>

 

[Jonathan West]

Hi Greg,

I had a need for this when doing a batch update on a set of templates. After
parameterising the FindReplaceAnywhere macro it worked fine for me,
replacing text in a textbox in the first page header of the template.

--
Regards
Jonathan West - Word MVP
www.intelligentdocuments.co.uk
Please reply to the newsgroup
Keep your VBA code safe, sign the ClassicVB petition www.classicvb.org