有个宏，求遍历文件夹和子文件夹中的WORD文档怎么写？

ofaye

有个宏，求遍历文件夹和子文件夹中的WORD文档怎么写？



Sub 编辑图片()
    For Each t In ActiveDocument.InlineShapes
        t.PictureFormat.Contrast = 0.9
    Next
End Sub

413191246se

楼主，如果是 Word2003，可以用 FileSearch 对象遍历文件夹及子文件夹；如果是 2007 及以上，须用 dir 遍历。下面是 Word2003 遍历文件夹及子文件夹示例代码：

1. Sub 批量打印()
   
2.     On Error Resume Next
   
3.     Dim fd As FileDialog, i&, doc As Document, p$, s As Section, j&, k$, x&, t&
   
4.     Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
5.     If fd.Show = -1 Then p = fd.SelectedItems(1) Else Exit Sub
   
6.     Set fd = Nothing
   
7.     If MsgBox("是否打印文件夹 " & p & " ?", 4 + 48) = vbNo Then Exit Sub
   
8.     k = InputBox("请输入打印份数！", "批量打印", "1")
   
9.     If k = "" Then Exit Sub
   
10.     For t = 1 To k
    
11.         With Application.FileSearch
    
12.             .NewSearch
    
13.             .LookIn = p
    
14.             .SearchSubFolders = True
    
15.             .FileName = "*.doc"
    
16.             If .Execute > 0 Then
    
17.                 For i = 1 To .FoundFiles.Count
    
18.                     Set doc = Documents.Open(FileName:=.FoundFiles(i), Visible:=False)
    
19.                     For Each s In doc.Sections
    
20.                         With s.PageSetup
    
21.                             If .Orientation = wdOrientLandscape Then j = 1 Else j = 0
    
22.                             If .PaperSize <> wdPaperA4 Then .PaperSize = wdPaperA4: If j = 1 Then .Orientation = wdOrientLandscape
    
23.                         End With
    
24.                     Next
    
25.                     doc.PrintOut
    
26.                     doc.Close savechanges:=wdDoNotSaveChanges
    
27.                 Next i
    
28.                 x = .FoundFiles.Count
    
29.             Else
    
30.                 MsgBox "未发现文件！", 0 + 16: End
    
31.             End If
    
32.         End With
    
33.         Dialogs(wdDialogNewToolbar).Display timeout:=1 '延时
    
34.     Next t
    
35.     MsgBox "打印完毕！共打印 " & x & " 个文件！" & k & " 份！", 0 + 48
    
36. End Sub

复制代码

ofaye

感谢楼上兄弟的回答。但我对vba了解不深。我的是word2007。
我的想法是，除了能把我的宏代码套用进去，把其他的宏代码套进去也能批量执行。

jiangxiaoyun

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.ClearContents
    Cells(1, 1) = "相对路径文件名"
    Cells(1, 2) = "绝对路径文件名"
    Getfd (ThisWorkbook.Path) 'ThisWorkbook.Path是当前代码文件所在路径，路径名可以根据需求修改
    Application.ScreenUpdating = True
End Sub
Sub Getfd(ByVal pth)
    Set Fso = CreateObject("scripting.filesystemobject")
    Set ff = Fso.getfolder(pth)
    For Each f In ff.Files
        Rem 具体提取哪类文件，还是需要根据文件扩展名进行处理
        Cells(Rows.Count, 1).End(3).Offset(1) = f.Name
        Cells(Rows.Count, 2).End(3).Offset(1) = f
    Next f
    For Each fd In ff.subfolders
        Getfd (fd)
    Next fd
End Sub

参考liulang0808版主的代码，改改就行。

413191246se

楼主，下面的小程序配合你1楼代码，试试：（注意：文件夹不能包含子文件夹）

1. Sub test()
   
2. '此宏仅处理文件夹（不包含子文件夹）
   
3.     Dim i$, p$
   
4.     p = "e:\zzz" '此路径自己改
   
5.     i = Dir(p & "*.docx")
   
6.     Do While Len(i) <> 0
   
7.         Documents.Open FileName:=p & i '打开文件
   
8.         编辑图片 '挂接外部程序
   
9.         ActiveDocument.Close savechanges:=wdSaveChanges '关闭并保存
   
10.         i = Dir
    
11.     Loop
    
12. End Sub

复制代码

ofaye

非常感谢，学习了。

413191246se

楼主，第04行代码应该改为如下（即最后添加了一个斜杠，否则会找不到文档的）：
p = "e:\zzz\"