VBA宏查找替换目录下所有Word文档中指定字符串

       原来搞质量管理，要替换质量文件里面所有特定名称或者某一错误时，需要逐一打开所有文件，非常麻烦，所以写了个VBA程序。过了这么多年，突然又要做同样的事情，发现新版本Word不支持其中的Application.FileSearch了，又找不到合适的工具。只能又学习了新的VBA代码，改写了原来的VBA窗体程序。分享给大家参考。

        首先要打开Word内置的宏编辑器，具体怎么操作自己网上搜吧，比较容易，我就不介绍了。打开后建立一个窗体UserForm1，加入控件主要有text1，text2或按钮。名称、标签自己放，自己喜欢写什么就写什么吧。我的是下图这样的。

         我原来写的代码是这样的，如果还有人用旧版的可以参考。在按钮触发事件里写代码如下。

Private Sub CommandButton1_Click()
Dim sPath As String

With Dialogs(wdDialogFileFind)   '设置文本查找对话框
    .SortBy = 2                  '文件按名称排列
    .SearchName = "*.doc"        '只列出word文档
    .Update                      '更新
End With

If Dialogs(wdDialogFileFind).Show = -1 Then             '如果按下打开，就执行
  sPath = Dialogs(wdDialogFileFind).SearchPath         '将查找对话框打开的路径附值给SPath
  Dialogs(wdDialogFileFind).Execute
Else
  Exit Sub            '如果取消或者关闭，就退出
End If

With Application.FileSearch
    .NewSearch
    .LookIn = sPath
    .SearchSubFolders = True
    .FileType = msoFileTypeWordDocuments
    .Execute
For i = 1 To .FoundFiles.Count
  Documents.Open (.FoundFiles(i))
  ActiveDocument.Select
  With Dialogs(wdDialogEditReplace)
  On Error GoTo Err
    .Find = TextBox1.Text
    .Replace = TextBox2.Text
    .ReplaceAll = True
    .Execute
  End With
  ActiveDocument.Save
  ActiveDocument.Close
Next i

End With
Err:
If TextBox1.Text = "" Then
  ActiveDocument.Save
  ActiveDocument.Close
End If
MsgBox "请输入替换查找的字串"

End Sub

          现在新版本的不能用Application.FileSearch，上网找了一下列举目录下文件的VBA代码，改了一下，主要就是用Dir()函数。修改后代码如下：

Private Sub CommandButton1_Click()
Dim sPath As String

With Dialogs(wdDialogFileFind)   '设置文本查找对话框
    .SortBy = 2                  '文件按名称排列
    .SearchName = "*.*"        '列出文档
    .Update                      '更新
End With

If Dialogs(wdDialogFileFind).Show = -1 Then             '如果按下打开，就执行
  sPath = Dialogs(wdDialogFileFind).SearchPath         '将查找对话框打开的路径附值给SPath
  Dialogs(wdDialogFileFind).Execute
Else
  Exit Sub            '如果取消或者关闭，就退出
End If

' 加入反斜杠如果路径字符串里没有
sPath = Trim(sPath)
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

DirFile = Dir(sPath & "*.*")
Do While DirFile <> ""
  Documents.Open (sPath & DirFile)
  ActiveDocument.Select
  With Dialogs(wdDialogEditReplace)
  On Error GoTo Err
    .Find = TextBox1.Text
    .Replace = TextBox2.Text
    .ReplaceAll = True
    .Execute
  End With
  ActiveDocument.Save
  ActiveDocument.Close
  DirFile = Dir 'next file
Loop

Err:
If TextBox1.Text = "" Then
  ActiveDocument.Save
  ActiveDocument.Close
End If
MsgBox "请输入替换查找的字串"

End Sub

        打开文档要允许执行宏，弹出窗体里输入要查找的字符串、替换的字符串，然后点确定，在弹出的打开文件对话框里找到你的文档所在的目录，点“打开”按钮就会执行查找替换，执行完出错就会跳出MsgBox "请输入替换查找的字串"。这个窗体宏不支持子目录搜索，需要查找替换的文件要放在相同目录下。如果要支持所有子目录，需要复杂一些的代码，我没有这个需要，如果有需要的人自己找找用dir函数历遍子目录的代码吧，需要把文件路径全面找完并存在一个文件路径集合里。