Public Sub FindReplaceAnywhere()
Dim rngStory As Word.Range
Dim pFindTxt As String
Dim pReplaceTxt As String
Dim lngJunk As Long
Dim oShp As Shape
Dim MyDialog As FileDialog, GetStr(1 To 100) As String '100 files is the maximum applying this code'
On Error Resume Next
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear
.Filters.Add "All WORD File ", "*.docx", 1
.AllowMultiSelect = True
i = 1
If .Show = -1 Then
For Each stiSelectedItem In .SelectedItems
GetStr(i) = stiSelectedItem
i = i + 1
Next
i = i - 1
End If
Application.ScreenUpdating = False
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
For j = 1 To i Step 1
Set Doc = Documents.Open(FileName:=GetStr(j), Visible:=True)
Windows(GetStr(j)).Activate
'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
'Iterate through all linked stories'
Do
SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
On Error Resume Next
Select Case rngStory.StoryType
Case 6, 7, 8, 9, 10, 11
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
Case Else
'Do Nothing'
End Select
On Error GoTo 0
'Get next linked story (if any)'
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
ActiveDocument.Save
ActiveWindow.Close
Next
Application.ScreenUpdating = True
End With
MsgBox "Complete!", vbInformation
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
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
End Sub