原来搞质量管理,要替换质量文件里面所有特定名称或者某一错误时,需要逐一打开所有文件,非常麻烦,所以写了个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函数历遍子目录的代码吧,需要把文件路径全面找完并存在一个文件路径集合里。