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函数历遍子目录的代码吧,需要把文件路径全面找完并存在一个文件路径集合里。

  • 0
    点赞
  • 2
    收藏
    觉得还不错? 一键收藏
  • 1
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值