文件夹遍历

x-xx-xx

ykcbf1100

应该不用搞这么复杂吧

x-xx-xx

ykcbf1100 发表于 2024-3-3 08:08
应该不用搞这么复杂吧

有看到过用集合的不过我不会用哈哈

x-xx-xx

ykcbf1100

ArrayList和Collection可以，数组也行。
用ArrayList的话要office2007版以上才可以。

x-xx-xx

x-xx-xx

x-xx-xx

x-xx-xx

opiona

https://club.excelhome.net/thread-1409141-1-1.html

1. '*******************************************************************************************************
   
2. '功能：    查找指定文件夹含子文件夹内所有文件名或文件夹名（含路径）
   
3. '函数名：  FileAllArr
   
4. '参数1：   Filename    需查找的文件夹名，不包含文件名
   
5. '参数2：   FileFilter  需要过滤的文件名，可省略，默认为：[*.*]
   
6. '参数3：   Liwai       剔除例外的文件名，可省略，默认为：空，一般为：ThisWorkbook.Name
   
7. '参数4：   SubFiles    是否需要查找子文件夹内文件，可省略，默认为：true
   
8. '参数5：   Files       是否只要文件夹名，可省略，默认为：FALSE
   
9. '返回值：  一个字符型的数组
   
10. '使用方法：FileArr = FileAllArr(ThisWorkbook.Path, "*.xls", ThisWorkbook.Name,false,false)
    
11. '作者:    北极狐工作室 QQ：14885553
    
12. '*******************************************************************************************************
    
13. Public Function FileAllArr(ByVal Filename As String, Optional ByVal FileFilter As String = "*.*", Optional ByVal Liwai As String = "", Optional ByVal SubFiles As Boolean = True, Optional ByVal Files As Boolean = False) As String()
    
14.    
    
15.     Dim DIC, DID, Ke, MyName, MyFileName
    
16.     Dim I As Long
    
17.    
    
18.     Set DIC = CreateObject("Scripting.Dictionary")    '创建一个字典对象
    
19.     Set DID = CreateObject("Scripting.Dictionary")
    
20.    
    
21.     Rem 如果文件夹路径 最后不是：[\] 则补充上去
    
22.     If Mid(Filename, Len(Filename), 1) <> "" Then
    
23.         Filename = Filename & ""
    
24.     End If
    
25.    
    
26.     DIC.Add (Filename), ""
    
27.     I = 0
    
28.     Do While I < DIC.Count
    
29.         Ke = DIC.keys   '开始遍历字典
    
30.         If SubFiles = True Then  '//如果需要查找子文件夹
    
31.             MyName = Dir(Ke(I), vbDirectory)    '查找目录
    
32.             Do While MyName <> ""
    
33.                 If MyName <> "." And MyName <> ".." Then
    
34.                     If (GetAttr(Ke(I) & MyName) And vbDirectory) = vbDirectory Then    '如果是次级目录
    
35.                         DIC.Add (Ke(I) & MyName & ""), ""  '就往字典中添加这个次级目录名作为一个条目
    
36.                     End If
    
37.                 End If
    
38.                 MyName = Dir    '继续遍历寻找
    
39.             Loop
    
40.         End If
    
41.         I = I + 1
    
42.     Loop
    
43.     Dim arrx() As String
    
44.     I = 0
    
45.     ReDim arrx(I)
    
46.     arrx(I) = ""
    
47.     If Files = True Then   '//是否只输出文件夹名
    
48.         
    
49.         For Each Ke In DIC.keys '以查找总表所在文件夹下所有excel文件为例
    
50.             ReDim Preserve arrx(I)
    
51.             If Ke <> Filename Then   '//自身文件夹除外
    
52.                 arrx(I) = Ke
    
53.                 I = I + 1
    
54.             End If
    
55.         Next
    
56.         FileAllArr = arrx
    
57.     Else
    
58.         For Each Ke In DIC.keys '以查找总表所在文件夹下所有excel文件为例
    
59.             MyFileName = Dir(Ke & FileFilter) '过滤器：EXCEL2003为：*.xls,excel2007为：*.xlsx
    
60.             Do While MyFileName <> ""
    
61.                 If MyFileName <> Liwai Then '排除例外文件
    
62.                     ReDim Preserve arrx(I)
    
63.                     arrx(I) = Ke & MyFileName
    
64.                     I = I + 1
    
65.                 End If
    
66.                 MyFileName = Dir
    
67.             Loop
    
68.         Next
    
69.         FileAllArr = arrx
    
70.     End If
    
71. End Function

复制代码