vbscript 在文件夹中的所有Word文档中查找和替换

Posted 2021-05-21

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