跟我学 【喜迎2015立春】遍历文件夹(含子文件夹)方法 ABC

香川群子

FSO 递归方法实现各种指定搜寻的完整代码：

1. 
   
2. Dim jg(), k&, tms# '因为是递归，所以事先指定存放结果的公用变量数组jg以及计数器k和起始时间tms
   
3. Sub ListFilesFso()
   
4.     sb& = InputBox("Search Type: AllFiles=0/Files=1/Folder=-1/All Folder=-2", "Find Files", 0) '选定返回模式
   
5.     SpFile$ = InputBox("匹配文件名或文件类型", "Find Files", ".xl") '指定匹配要求，留空则匹配全部
   
6.     If SpFile Like ".*" Then SpFile = LCase(SpFile) & "*" '如果指定了文件类型则一律转换为大写字母方便比较
   
7.    
   
8.     With Application.FileDialog(msoFileDialogFolderPicker)
   
9.         If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
   
10.     End With
    
11.     If Right(myPath, 1) <> "" Then myPath = myPath & ""
    
12.    
    
13.     ReDim jg(65535, 3)
    
14.     jg(0, 0) = "Ext": jg(0, 1) = IIf(sb < 0, IIf(Len(SpFile), "Filename", "No"), "Filename")
    
15.     jg(0, 2) = "Folder": jg(0, 3) = "Path"
    
16.     '定义存放文件名结果的数组jg 、并写入标题
    
17.     tms = Timer: k = 0: Call ListAllFso(myPath, sb, SpFile) '调用递归过程检查指定文件夹及其子文件夹
    
18.     If sb < 0 And Len(SpFile) = 0 Then Application.StatusBar = "Get " & k & " Folders."
    
19.     [a1].CurrentRegion = "": [a1].Resize(k + 1, 4) = jg: [a1].CurrentRegion.AutoFilter Field:=1
    
20.     '输出结果到工作表，并启用筛选模式
    
21. End Sub
    
22. 
    
23. Function ListAllFso(myPath$, Optional sb& = 0, Optional SpFile$ = "") '递归检查子文件夹的过程代码
    
24.     Set fld = CreateObject("Scripting.FileSystemObject").GetFolder(myPath)
    
25.     On Error Resume Next
    
26.     If sb >= 0 Or Len(SpFile) Then '如果模式为0或1、或指定了匹配文件要求，则遍历各个文件
    
27.         For Each f In fld.Files '用FSO方法遍历文件.Files
    
28.             t = False '匹配状态初始化
    
29.             n = InStrRev(f.Name, "."): fnm = Left(f.Name, n - 1): x = LCase(Mid(f.Name, n))
    
30.             If Err.Number Then Err.Clear
    
31.             
    
32.             If SpFile = " " Then 'Space 如果匹配要求为空则匹配全部
    
33.                 t = True
    
34.             ElseIf SpFile Like ".*" Then '如果匹配要求为文件类型则
    
35.                 If x Like SpFile Then t = True '当文件符合文件类型要求时匹配，否则不匹配
    
36.             Else '否则为需要匹配文件名称中的一部分
    
37.                 If InStr(fnm, SpFile) Then t = True '如果匹配则状态为True
    
38.             End If
    
39.             If t Then k = k + 1: jg(k, 0) = x: jg(k, 1) = "'" & fnm: jg(k, 2) = fld.Name: jg(k, 3) = fld.Path
    
40.         Next
    
41.         Application.StatusBar = Format(Timer - tms, "0.0s") & " Get " & k & " Files , Searching in Folder ... " & fld.Path
    
42.     End If
    
43.    
    
44.     For Each fd In fld.SubFolders '然后遍历检查所有子文件夹.SubFolders
    
45.         If sb < 0 And Len(SpFile) = 0 Then k = k + 1: jg(k, 0) = "fld": jg(k, 1) = k: jg(k, 2) = fd.Name: jg(k, 3) = fld.Path
    
46.         If sb Mod 2 = 0 Then Call ListAllFso(fd.Path, sb, SpFile)
    
47.     Next
    
48. End Function
    

复制代码

呵呵。这样应该很好了。

香川群子

jpj123 发表于 2015-2-4 10:58
很好的帖子，但是建议老师写个附件。呵呵!

给你的各种代码以及注释，你自己边看边学习，或者复制后拿回去用就是了。

不需要附件……因为这个是给大家学习的。

如果需要文件，应该你自己去做。
代码运行中有问题，你可以上附件来问。

香川群子

关于Dos中Dir命令的开关问题：

【提取文档】
.Exec("cmd /c dir /a-d /b "  ………Dir返回指定文件夹下【不包括子文件夹】的所有文档名（不含文件夹）
.Exec("cmd /c dir /a-d /b /s "  ………Dir返回指定文件夹下【包括子文件夹】在内的所有文档名（不含文件夹）

其中， /s 即 是否包含 SubFolder的意思
而 /a-d 是文件对象中排除文件夹目录(-d)只剩下文档的意思。

【提取文件夹】
.Exec("cmd /c dir /a-a /b "  ………Dir返回指定文件夹下【不包括子文件夹】内的所有子文件夹名（不含文档）
.Exec("cmd /c dir /a-a /b /s "  ………Dir返回指定文件夹下【包括子文件夹】内的所有子文件夹名（不含文档）
而 /a-a 是文件对象中排除文档(-a)只剩下文件夹目录的意思。

【提取文档和文件夹】
.Exec("cmd /c dir /b "  ………Dir返回指定文件夹下【不包括子文件夹】的所有【文档名】和【文件夹名】
.Exec("cmd /c dir /b /s "  ………Dir返回指定文件夹下【包括子文件夹】的所有【文档名】和【文件夹名】


呵呵，以上6种的开关组合就足够了。
补充：Dos Dir开关的帮助文件：

显示目录中的文件和子目录列表。

DIR [drive:][path][filename] [/A[[:]attributes]] [/B] [/C] [/D] [/L] [/N]
  [/O[[:]sortorder]] [/P] [/Q] [/S] [/T[[:]timefield]] [/W] [/X] [/4]

  [drive:][path][filename]
              指定要列出的驱动器、目录和/或文件。

  /A          显示具有指定属性的文件。
  attributes   D  目录                R  只读文件
               H  隐藏文件            A  准备存档的文件
               S  系统文件            -  表示“否”的前缀
/B          使用空格式(没有标题信息或摘要)。
  /C          在文件大小中显示千位数分隔符。这是默认值。用 /-C 来
              停用分隔符显示。
  /D          跟宽式相同，但文件是按栏分类列出的。
  /L          用小写。
  /N          新的长列表格式，其中文件名在最右边。
  /O          用分类顺序列出文件。
  sortorder    N  按名称(字母顺序)     S  按大小(从小到大)
               E  按扩展名(字母顺序)   D  按日期/时间(从先到后)
               G  组目录优先           -  颠倒顺序的前缀
  /P          在每个信息屏幕后暂停。
  /Q          显示文件所有者。
  /S          显示指定目录和所有子目录中的文件。
  /T          控制显示或用来分类的时间字符域。
  timefield   C  创建时间
              A  上次访问时间
              W  上次写入的时间
  /W          用宽列表格式。
  /X          显示为非 8dot3 文件名产生的短名称。格式是 /N 的格式，
              短名称插在长名称前面。如果没有短名称，在其位置则
              显示空白。
  /4          用四位数字显示年

可以在 DIRCMD 环境变量中预先设定开关。通过添加前缀 - (破折号)
来替代预先设定的开关。例如，/-W。

cpy123581321

专业贴
学习了

小花鹿

支持楼主。
FSO递归应该写代码简单，但理解起来困难些，我喜欢FSO递归。

香川群子

小花鹿 发表于 2015-2-4 14:20
支持楼主。
FSO递归应该写代码简单，但理解起来困难些，我喜欢FSO递归。

是的，非常简单……不能再简单啦。

1. Function ListAllFso(myPath$)
   
2.     Set fld = CreateObject("Scripting.FileSystemObject").GetFolder(myPath)
   
3.     For Each f In fld.Files
   
4.         [a65536].End(3).Offset(1) = f.Name
   
5.     Next
   
6.     For Each fd In fld.SubFolders
   
7.         [a65536].End(3).Offset(1) = " " & fd.Name & ""
   
8.         Call ListAllFso(fd.path)
   
9.     Next
   
10. End Function

复制代码

张文洲

这是个永恒的话题，能把多种技巧汇总整理都一起，便于随时查阅参考，是很好的资料，点个赞

香川群子

前面的Dir代码，是两个Do循环嵌套使用，
一边检查当前文件夹内的子文件夹，一边检查当前文件夹内的文件。


其实，Dir方法也可以这么写代码：
① 检查并列出所有子文件夹
② 然后根据需要遍历所有子文件夹中的文件

即，两个Do循环是分开来的。
但是、第2次的Do循环需要外套For循环遍历所有已知子文件夹。

1. Sub ListFilesDir()
   
2.     With Application.FileDialog(msoFileDialogFolderPicker)
   
3.         If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
   
4.     End With
   
5.     If Right(myPath, 1) <> "" Then myPath = myPath & ""
   
6.    
   
7.     MsgBox Join(ListAllDir(myPath), vbCr) 'GetAllSubFolder's File
   
8.     MsgBox Join(ListAllDir(myPath, 1), vbCr) 'GetThisFolder's File
   
9.    
   
10.     MsgBox Join(ListAllDir(myPath, -1), vbCr) 'GetThisFolder's SubFolder
    
11.     MsgBox Join(ListAllDir(myPath, -2), vbCr) 'GetAllSubFolder
    
12.    
    
13.     MsgBox Join(ListAllDir(myPath, , "tst"), vbCr) 'GetAllSubFolder's SpecialFile
    
14.     MsgBox Join(ListAllDir(myPath, 1, "tst"), vbCr) 'GetThisFolder's SpecialFile
    
15. End Sub
    
16. 
    
17. Function ListAllDir(myPath$, Optional sb& = 0, Optional SpFile$ = "")
    
18.     Dim i&, j&, k&, myFile$
    
19.     ReDim fld(0)
    
20.    
    
21.     fld(0) = myPath
    
22.     On Error Resume Next
    
23.     Do
    
24.         myFile = Dir(fld(i), vbDirectory)
    
25.         Do While myFile <> ""
    
26.             If myFile <> "." And myFile <> ".." Then
    
27.                 If (GetAttr(fld(i) & myFile) And vbDirectory) = vbDirectory Then
    
28.                     If Err.Number Then Err.Clear Else j = j + 1: ReDim Preserve fld(j): fld(j) = fld(i) & myFile & ""
    
29.                 End If
    
30.             End If
    
31.             myFile = Dir
    
32.         Loop
    
33.         If sb Mod 2 Then Exit Do Else i = i + 1
    
34.     Loop Until i > UBound(fld)
    
35.     If sb < 0 And Len(SpFile) = 0 Then ListAllDir = fld: Exit Function
    
36.     '以上为止，遍历检查并列出指定目标文件夹中、所有的子文件夹。
    
37.    
    
38.     '以下为遍历已获得的子文件夹数组fld 然后Dir循环检查其中所有的文件
    
39.     ReDim file(0)
    
40.     For i = 0 To UBound(fld)
    
41.         myFile = Dir(fld(i), vbDirectory)
    
42.         Do While myFile <> ""
    
43.             If myFile <> "." And myFile <> ".." Then
    
44.                 If Not (GetAttr(fld(i) & myFile) And vbDirectory) = vbDirectory Then
    
45.                     If SpFile = "" Then
    
46.                         file(k) = myFile: k = k + 1: ReDim Preserve file(k)
    
47.                     Else
    
48.                         If InStr(myFile, SpFile) Then file(k) = myFile: k = k + 1: ReDim Preserve file(k)
    
49.                     End If
    
50.                 End If
    
51.             End If
    
52.             myFile = Dir
    
53.         Loop
    
54.     Next
    
55.     ListAllDir = file
    
56. End Function
    

复制代码

一般说，还是第1种两个Do嵌套的方法好……虽然代码中需要同时处理文件夹和文件名，但Do循环比较高效一些。

第2种方法也并非全无是处。
当处理文件为重点时，以第2种方法比较好。

wshcw

已收藏学习,并建议本版版主加精华或加技术.

香川群子

希望本帖成为【遍历子文件夹】方法的终结技术帖。呵呵。