循环遍历文件夹及子文件夹文件宏（捷克人编程）

413191246se

* Word2003 用 FileSearch 对象可以达成目标，但最近我发现一是太慢，二是似乎宏有时不运行了。
* 在网上找了很多 FSO（递归）和用 DIR 函数（包括双字典）的方法，但均未达到目的。
* 下面是捷克人编程的 VBA 宏，能够循环遍历文件夹及子文件夹中文件，在 Word2003 中我已经测试通过，并且我已经将 6000 来个 Word 文档极速地转换为 TXT 纯文本文档作为资料来保存。有需要的朋友可以试用此宏，但要注意：操作前保留备份及核查文件数目、内容。

1. Sub 批量转换doc2txt_dir()
   
2.     On Error Resume Next
   
3.     Dim fd As FileDialog, p$, doc As Document, n&
   
4.     Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
5.     If fd.Show = -1 Then p = fd.SelectedItems(1) Else End
   
6.     Set fd = Nothing
   
7.     If MsgBox("是否转换文件夹 " & p & " ?", 4 + 48) = vbNo Then End
   
8.     Dim FileNameWithPath As Variant, ListOfFilenamesWithParh As New Collection
   
9.     Call FileSearchByHavrda(ListOfFilenamesWithParh, p, "*.doc", True)
   
10.     For Each FileNameWithPath In ListOfFilenamesWithParh
    
11.         Set doc = Documents.Open(FileName:=FileNameWithPath, Visible:=False)
    
12.         With doc
    
13.             .SaveAs FileName:=Left(FileNameWithPath, Len(FileNameWithPath) - 4), FileFormat:=wdFormatText
    
14.             .Close
    
15.         End With
    
16.         n = n + 1
    
17.     Next FileNameWithPath
    
18.     If ListOfFilenamesWithParh.Count = 0 Then MsgBox "File not found!"
    
19.     MsgBox "转换完毕！共转换 " & n & " 个文档！", 0 + 48
    
20. End Sub
    
21. Sub FileSearchByHavrda(pFoundFiles As Collection, pPath As String, pMask As String, pIncludeSubdirectories As Boolean)
    
22.     Dim DirFile As String, CollectionItem As Variant, SubDirCollection As New Collection
    
23.     pPath = Trim(pPath)
    
24.     If Right(pPath, 1) <> "" Then pPath = pPath & ""
    
25.     DirFile = Dir(pPath & pMask)
    
26.     Do While DirFile <> ""
    
27.         pFoundFiles.Add pPath & DirFile
    
28.         DirFile = Dir
    
29.     Loop
    
30.     If Not pIncludeSubdirectories Then Exit Sub
    
31.     DirFile = Dir(pPath & "*", vbDirectory)
    
32.     Do While DirFile <> ""
    
33.         If DirFile <> "." And DirFile <> ".." Then If ((GetAttr(pPath & DirFile) And vbDirectory) = 16) Then SubDirCollection.Add pPath & DirFile
    
34.         DirFile = Dir
    
35.     Loop
    
36.     For Each CollectionItem In SubDirCollection
    
37.          Call FileSearchByHavrda(pFoundFiles, CStr(CollectionItem), pMask, pIncludeSubdirectories)
    
38.     Next
    
39. End Sub

复制代码

Excel2119

这是在做文件夹内的目录吗？

ming0018

6000 来个 Word 文档极速地转换为 TXT 纯文本文档　有多极速？把你的用时公布一下？
我用FSO（递归）就能做到了！

413191246se

2楼朋友：这是一个外国人（捷克人）编程的 VBA 宏，功能是：循环遍历文件夹及子文件夹中的文件。
3楼 ming 老师：极速是我的感觉，因为 DIR 函数 就是比 FileSearch 快多了，所以，具体时间我没记，但感觉很快。——但最关键的是，不管 老师 用什么方法，我都不会啊！我也看不懂高级一些的代码，我只是试用觉得能用达到目的就好。