查找与替换的基本代码用法之四-全文件夹替换 (VBA)

功能简介:批量多文件（全文件夹）的多文本一次性替换操作。
运行本程序后，先输入需查找和与之对应的替换的文本，然后点击“选择文件夹”，您
可以找到指定的文件夹中的部分或者所有文件，注意，您需要全选文件（CTRL+A），或
者使用 SHIFT/CTRL 配合鼠标键选取多个文件），确定后自动进行批量替换。

Private Sub Document_Open()
Application.Windows(ThisDocument.Name).Visible = False
MySub
End Sub
'----------------------
Sub MySub()
UserForm1.Show
End Sub
'----------------------

Private Sub CommandButton1_Click()
Me.TextBox1 = ""
Me.TextBox2 = ""
Me.TextBox1.SetFocus
End Sub
'----------------------
Private Sub CommandButton2_Click()
Dim MyFind() As String, MyRep() As String, i As Integer, aStory As Variant
Dim MyDialog As FileDialog, vrtSelectdeItem As Variant, Doc As Document
On Error Resume Next
'检查是否为空
MsgBox "请先正确录入查找与对应替换的内容,以英文逗号分隔" & vbCrLf & _
"在选定文件夹中,您可以全选或部分选定文件(CTRL/SHIFT)+鼠标单击",
vbInformation

If Me.TextBox1 = "" And Me.TextBox2 = "" Then Exit Sub
MyFind = Split(Me.TextBox1, ",")
MyRep = Split(Me.TextBox2, ",")
If UBound(MyRep) <> UBound(MyFind) Then
'如果两个文本框的分隔数目不一致,提示
MsgBox "替换的数目与查找数目不一致!", vbExclamation + vbOKOnly,
"Warnning"
Me.TextBox2.SetFocus
Exit Sub
End If
'定义一个文件夹选取对话框
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear    '清除所有文件筛选器中的项目
.Filters.Add "所有 WORD 文件", "*.doc", 1    '增加筛选器的项目为所有
WORD文件
.AllowMultiSelect = True    '允许多项选择
If .Show = -1 Then    '确定
Application.ScreenUpdating = False
For Each vrtselecteditem In .SelectedItems    '在所有选取项目中循环
Set Doc = Documents.Open(FileName:=vrtselecteditem,
Visible:=False)
'定义两个数组,以","分隔
With Doc
For i = 0 To UBound(MyFind)    '一个从下标为 0 的循环替换
For Each aStory In .StoryRanges    '在文档的各个文字部
分
'如果是"",则相当于删除原查找内容
aStory.Find.Execute findtext:=MyFind(i), _
replacewith:=VBA.IIf(MyRep(i
= """""", "", MyRep(i)), Replace:=2
'如果有下一节中相同内容文字部分,也进行替换
If Not aStory.NextStoryRange Is Nothing Then _
aStory.NextStoryRange.Find.Execute
findtext:=MyFind(i), _
replacewith:=VBA.IIf(MyRep(i) = """""", "",
MyRep(i)), Replace:=2
Next
Next
Doc.Close True
End With
Next vrtselecteditem
End If
End With
Application.ScreenUpdating = True
Unload Me    '卸载窗体
End Sub
'----------------------
Private Sub UserForm_Initialize()

Me.Caption = "多文本替换操作"
Me.TextBox1.SetFocus
Me.CommandButton2.Default = True
End Sub
'----------------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ThisDocument.Close False
End Sub
'----------------------