findreplaceall.vbs
Sub Search_and_Replace()
' 200 files is the maximum applying this code
Dim MyDialog As FileDialog, GetStr(1 To 200) As String
On Error Resume Next
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
' ---------------------------------------------------------------
' *.doc? allows processing of *.doc and *.docx files.
' ---------------------------------------------------------------
With MyDialog
.Filters.Clear
.Filters.Add "All WORD File ", "*.doc?", 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
For j = 1 To i Step 1
Set Doc = Documents.Open(FileName:=GetStr(j), Visible:=True)
' -------------------------------------------------------
' Beginning Header Updates
' -------------------------------------------------------
Windows(GetStr(j)).Activate
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
If ActiveWindow.View.SplitSpecial wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
' --- begin header text replacement 1 ---
With Selection.Find
.Text = "St John's Offices" ' Find What
.Replacement.Text = "Howard Court" ' Replace With
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
If .Found = True Then
ChangeMade = True
End If
End With
Selection.Find.Execute Replace:=wdReplaceAll
' --- End header text replacement 1 ---
' --- begin header text replacement 2 ---
With Selection.Find
.Text = "Albion Street" ' Find What
.Replacement.Text = "Manor Park" ' Replace With
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
If .Found = True Then
ChangeMade = True
End If
End With
Selection.Find.Execute Replace:=wdReplaceAll
' --- begin header text replacement 2 ---
' --- begin header text replacement 3 ---
With Selection.Find
.Text = "Leeds" ' Find What
.Replacement.Text = "Runcorn" ' Replace With
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
If .Found = True Then
ChangeMade = True
End If
End With
Selection.Find.Execute Replace:=wdReplaceAll
' --- begin header text replacement 3 ---
' --- begin header text replacement 4 ---
With Selection.Find
.Text = "LS2 8LQ" ' Find What
.Replacement.Text = "WA7 1SJ" ' Replace With
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
If .Found = True Then
ChangeMade = True
End If
End With
Selection.Find.Execute Replace:=wdReplaceAll
' --- begin header text replacement 4 ---
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
' ------------------------------------------------------
' End of Header Updates
' ------------------------------------------------------
' -------------------------------------------------------
' Beginning of Body Updates
' -------------------------------------------------------
Windows(GetStr(j)).Activate
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Delete additional body replacement blocks if
' not needed or copy/paste additional blocks if
' required.
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' --- begin body text replacement 1 ---
With Selection.Find
.Text = "Leeds" ' Find What
.Replacement.Text = "Mersey" ' Replace With
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' --- end body text replacement 1 ---
' -------------------------------------------------------
' Beginning footer Updates
' -------------------------------------------------------
Windows(GetStr(j)).Activate
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
If ActiveWindow.View.SplitSpecial wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
' --- begin footer text replacement 1 ---
With Selection.Find
.Text = "Leeds" ' Find What
.Replacement.Text = "Mersey" ' Replace With
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
If .Found = True Then
ChangeMade = True
End If
End With
Selection.Find.Execute Replace:=wdReplaceAll
' --- End footer text replacement 1 ---
Application.Run macroname:="NEWMACROS"
ActiveDocument.Save
ActiveWindow.Close
' -------------------------------------------------------
' End of Body Updates
' -------------------------------------------------------
Next
Application.ScreenUpdating = True
End With
MsgBox "operation end, please view", vbInformation
End Sub