遍历文件夹下所有word，执行固定的宏

13907933959

duquancai 发表于 2017-3-9 21:09
附件，打开文档，点击按钮》》》》》》》》

杜前辈好！
唉！菜鸟就是菜鸟，照着抄都不行，运行提示“编译错误：用户定义类型未定义”，看了多遍都不知抄错在那里，请前辈指点，谢谢！

Sub shishi()
    Dim nej As New Blclass, fol As Object, arr, a, doc As Document
    Setfol = CreateObject("Shell.Application").BrowseForFolder(0, "选取初始文件夹", 0)
    If Not fol Is Nothing Then pa$ = fol.Items.Item.Path Else MsgBox "选取目标文件夹": Exit Sub
    arr = nej.DirSK(pa, "*.doc*")
    For Each a In arr
        Set doc = Documents.Open(a, Visible:=False)
        With doc
            .Content.Font.Color = RGB(0, 0, 0)
            .Close -1, 1
        End With
    Next
End Sub

jiminyanyan

13907933959 发表于 2017-3-11 07:42
杜前辈好！
唉！菜鸟就是菜鸟，照着抄都不行，运行提示“编译错误：用户定义类型未定义”，看了多遍都不 ...

杜前辈的我没看，我8楼有个代码，你可以参考一下。

13907933959

jiminyanyan 发表于 2017-3-11 10:04
杜前辈的我没看，我8楼有个代码，你可以参考一下。

前辈好！
您8楼的代码我昨天也试了，不知什么原因，运行提示 “编译错误：‘5’ 无效的过程调用或参数”。
我是03版的office。

13907933959

jiminyanyan 发表于 2017-3-11 10:04
杜前辈的我没看，我8楼有个代码，你可以参考一下。

前辈好！
测试您9楼的附件，代码运行一样提示 “编译错误：‘5’ 无效的过程调用或参数”。

努牛

jiminyanyan 发表于 2017-3-9 20:26
借用ＤＵ老师的代码，写一个……。

大神，我运行也出现了“运行时错误'5'：无效的过程调用或参数”。我是07版的office。

jiminyanyan

努牛 发表于 2017-3-11 12:02
大神，我运行也出现了“运行时错误'5'：无效的过程调用或参数”。我是07版的office。

9 楼有附件，我的是2010.……。

zhanglei1371

真是够菜的，一个小问题拉了这么多层：
两种方案：
一、修改上面的代码（不完美）

1. Sub 遍历所有文件夹中的文件()
   
2.   Dim arr() As String, i&, k&, x&, f, f1$, oDoc As Document
   
3.   Dim Osec As Section, Ohefo As HeaderFooter
   
4.   Application.ScreenUpdating = False
   
5.     With Application.FileDialog(msoFileDialogFolderPicker)
   
6.         If .Show = False Then Exit Sub
   
7.         ReDim Preserve arr(1)
   
8.         arr(1) = .SelectedItems(1) & "\"
   
9.     End With
   
10.     i = 1: k = 1
    
11.     Do While i < UBound(arr) + 1
    
12.         If arr(i) = "" Then Exit Do
    
13.         f = Dir(arr(i), vbDirectory)
    
14.         Do While f <> ""
    
15.             If InStr(f, ".") = 0 And f <> "" Then
    
16.                 k = k + 1
    
17.                 ReDim Preserve arr(k)
    
18.                 arr(k) = arr(i) & f & "\"
    
19.             End If
    
20.             f = Dir
    
21.         Loop
    
22.         i = i + 1
    
23.     Loop
    
24.     For x = 1 To UBound(arr)
    
25.         If arr(x) = "" Then Exit For
    
26.         f1 = Dir(arr(x) & "*.doc*")
    
27.         Do While f1 <> ""
    
28.             Set oDoc = Documents.Open(arr(x) & f1, Visible:=True)
    
29.             Selection.WholeStory
    
30.             Selection.Font.Color = wdColorBlack
    
31.             oDoc.Close True
    
32.             Set oDoc = Nothing
    
33.             f1 = Dir
    
34.         Loop
    
35.     Next x: Erase arr
    
36.   Application.ScreenUpdating = True
    
37. End Sub
    

复制代码

二、CMD方式:

1. Sub CMD遍历处理文件()
   
2.     Dim ws As Object, arr, fod
   
3.     With Application.FileDialog(msoFileDialogFolderPicker)
   
4.         If .Show <> -1 Then Exit Sub Else fod = .InitialFileName
   
5.     End With
   
6.     CreateObject("wscript.shell").Run "cmd /c dir " & Chr(34) & fod & "*.doc*" & Chr(34) & " /s /b /a:-d > C:\temdoc.txt", 0, True
   
7.     Open "C:\temDoc.txt" For Input As #1 ’利用批处理dir命令生成临时文件列表于C盘；

复制代码

    Close #1 '关闭文件号为1的文件；
    VBA.Kill "c:\temdoc.txt" ’删除临时文件；
    arr = Filter(arr, "$", False, vbTextCompare)    '过滤掉word临时文件~$
    For Each f In arr
        If f <> "" Then
            '此处添加单个文档处理代码即可。
            
        End If
    Next
End Sub



ps:发帖后需要用双反斜杠才能显示，编辑后还可能乱码，看来还是发图片稳妥，无需审核。

duquancai

13907933959 发表于 2017-3-11 07:42
杜前辈好！
唉！菜鸟就是菜鸟，照着抄都不行，运行提示“编译错误：用户定义类型未定义”，看了多遍都不 ...

我提供的附件难道不能运行吗？又或者运行结果不对吗？附件中不是提供了运行按钮吗？点击按钮不行吗？

13907933959

duquancai 发表于 2017-3-11 18:01
我提供的附件难道不能运行吗？又或者运行结果不对吗？附件中不是提供了运行按钮吗？点击按钮不行吗？

杜前辈好！

我下载了您在10楼提供的带代码的压缩件，解压后点附件中的运行按钮，不知什么原因试了多次都没有反应，想看一下代码您又设置了密码。

13907933959

zhanglei1371 发表于 2017-3-11 16:39
真是够菜的，一个小问题拉了这么多层：
两种方案：
一、修改上面的代码（不完美）

前辈好！
我运行试了第一个修改后代码，测试的文档上好像没有什么变化。
太菜了，第二个代码，不知怎样加上处理单个文档的代码，前辈能否示范一个？谢谢！