word2010如何用VBA实现多文件批量替换

qiushui1412

需求：将某一文件夹内所有word文档中的“建设一班”替换为“建设二班”。找到过2003版能用的，但是2010用不了，网上搜了很久也没找到能用的，拜托各位帮忙解决一下，谢谢了。

qiushui1412

顶一下 希望有人能帮忙

闻启学

qiushui1412 发表于 2014-12-20 17:00
顶一下 希望有人能帮忙

一样的 代码 无什么分别 啊  都是查找替换的  

qiushui1412

闻启学 发表于 2014-12-20 22:38
一样的 代码 无什么分别 啊  都是查找替换的

好像是遍历文件的那部分代码有区别 能帮忙找一下么？万分感谢。

闻启学

qiushui1412 发表于 2014-12-20 23:08
好像是遍历文件的那部分代码有区别 能帮忙找一下么？万分感谢。

你不会是用 filesearch 吧

这个 07 版本  后已经停止使用啊

使用 dir 吧

loquat

请测试

1. Sub 查找替换_loquat()
   
2. Application.ScreendUpdating = False
   
3. Dim arr, folder$
   
4. Dim aDoc As Document, aRange As Range
   
5. folder = """" & "C:\Program Files" & """" '设置文件路径
   
6. With CreateObject("WScript.Shell")
   
7.        .Run Environ$("comspec") & " /c dir " & folder & "*.doc /s /a:-d /b > C:\temp.txt", 0, True
   
8. End With
   
9. aNum = FreeFile
   
10. Open "C:\temp.txt" For Input As #aNum
    
11.     arr = Split(StrConv(InputB(LOF(aNum), aNum), vbUnicode), vbCrLf)
    
12. Close #aNum
    
13. For i = 0 To UBound(arr)
    
14.     Set aDoc = Documents.Open(arr(i))
    
15.     Set aRange = aDoc.Content
    
16.     With aRange.Find
    
17.         .ClearFormatting
    
18.         .Replacement.ClearFormatting
    
19.         .Text = "建设一班"
    
20.         .Replacement.Text = "建设二班"
    
21.         .Forward = True
    
22.         .Wrap = wdFindStop
    
23.         .MatchByte = True
    
24.         .Execute Replace:=wdReplaceAll
    
25.     End With
    
26.     aDoc.Close True
    
27. Next
    
28. Application.ScreendUpdating = True
    
29. End Sub
    

复制代码

loquat

上面方法生成了临时文件c:\temp.txt，且执行完过程未删除临时文件。。。

qiushui1412

loquat 发表于 2014-12-21 14:17
上面方法生成了临时文件c:\temp.txt，且执行完过程未删除临时文件。。。

为什么没有管用…… 生成的temp是空文件 我改了文件路径
folder = "F:\Work\新建文件夹"
拓展名改成docx
其他没有动……

qiushui1412

闻启学 发表于 2014-12-21 11:00
你不会是用 filesearch 吧

这个 07 版本  后已经停止使用啊

哎 dir好像很难学会的样子…… 能指导一下么？

loquat

Sub 查找替换_loquat()
Application.ScreendUpdating = False
Dim arr, folder$
Dim aDoc As Document, aRange As Range
folder = """" & "F:\Work\新建文件夹\" & """" '设置文件路径
With CreateObject("WScript.Shell")
       .Run Environ$("comspec") & " /c dir " & folder & "*.docx /s /a:-d /b > C:\temp.txt", 0, True
End With
aNum = FreeFile
Open "C:\temp.txt" For Input As #aNum
    arr = Split(StrConv(InputB(LOF(aNum), aNum), vbUnicode), vbCrLf)
Close #aNum
For i = 0 To UBound(arr)
    Set aDoc = Documents.Open(arr(i))
    Set aRange = aDoc.Content
    With aRange.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "建设一班"
        .Replacement.Text = "建设二班"
        .Forward = True
        .Wrap = wdFindStop
        .MatchByte = True
        .Execute Replace:=wdReplaceAll
    End With
    aDoc.Close True
Next
Application.ScreendUpdating = True
End Sub