超好用的遍历文件夹及子文件夹,返回文件列表数组,可搜索文件类型,傻瓜版通用VBA函数

百度不到去谷歌 · 发表于 2014-4-28 22:36

本帖最后由百度不到去谷歌于 2014-4-28 22:45 编辑

最近看到很多人问遍历文件的问题,其实百度上很多,还有些人在用dir,dir对文件名有诸多限制的

还是跟着微软用FileSystemObject吧,我整理了一下代码,封装成一个通用函数,

调用的时候只需要直接导入Mfiles模块或者复制代码到新模块

根据需要调整参数即可,希望下次有人再需要的时候能百度到我这里,也少走一些弯路

闲话少上代码表格奉上

'-----------Function GetAllPath----------百度不到去谷歌 QQ80871835 2014/4/28---------------------------
'功能 :'遍历path目录,返回所有文件名或者文件夹名数组,可选长短路径,可选文件类型,可选文件夹或文件
'变量 :path string -文件夹路径
'op FileType string -文件类型,可用*.*来匹配特定文件类型,或者直接*x*模糊搜索文件及文件夹也可
'op Fullname Boolean -是否返回完整路径,默认为true返回完整
'op IsFolder Boolean -返回文件还是文件夹,true为文件夹,false为文件,默认是文件
' 示例: MsgBox "返回xls和txt文件全路径" & vbNewLine & Join(GetAllPath(ThisWorkbook.Path, "*.xls|*.txt"), vbNewLine)
'--------------------------------------------------------------------------------------------------
Function GetAllPath(Path$, Optional FileType$ = "*", _
Optional FullName As Boolean = True, Optional IsFolder As Boolean = False)
Dim dic As Object, i&, Fso As Object, Folder As Object
Set dic = CreateObject("Scripting.Dictionary") '字典key存放路径,item存放名字
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Folder = Fso.GetFolder(Path)
i = 1
Call GetPath(Folder, dic, FileType, IsFolder)
If FullName Then
GetAllPath = dic.keys '返回文件名
Else
GetAllPath = dic.items '返回完整路径带文件名
End If
Set Folder = Nothing: Set Fso = Nothing
End Function
Private Sub GetPath(ByVal Folder As Object, dic, Optional FileType$ = "*", Optional ByVal IsFolder As Boolean = False)
Dim SubFolder As Object '遍历文件夹及子文件夹获取对应搜索列表的文件
Dim File As Object, i&, arr
If IsFolder Then '返回文件夹路径
For Each SubFolder In Folder.SubFolders
If FileSerch(FileType, SubFolder.Name) Then dic.Add SubFolder.Path, SubFolder.Name
Call GetPath(SubFolder, dic, FileType, IsFolder) '递归调用子文件夹
Next
Else '遍历文件,返回文件路径
For Each File In Folder.Files '遍历文件
If FileSerch(FileType, File.Name) Then dic.Add File.Path & "" & File.Name, File.Name
'搜索列表,多个匹配项用|分隔,可用户自由发挥,常用与匹配文件类型,也可用于搜索包含关键字文件
Next
For Each SubFolder In Folder.SubFolders
Call GetPath(SubFolder, dic, FileType, IsFolder) '递归调用子文件夹
Next
End If
End Sub
Private Function FileSerch(FileType$, fname$) As Boolean
Dim arr, i&
arr = Split(FileType, "|") '搜索列表,多个匹配项用|分隔,可用户自由发挥,常用与匹配文件类型,也可用于搜索包含关键字文件
For i = 0 To UBound(arr)
If fname Like arr(i) Then FileSerch = True: Exit Function '匹配到其中一项即退出判断
Next
End Function-

复制代码

使用示例

Public Sub rngtest() '当前目录下
[A3:E65536] = ""
GetPathToRng [A3], ThisWorkbook.Path, "*.xls|*.txt" '返回xls和txt文件全路径
GetPathToRng [B3], ThisWorkbook.Path, , False '返回所有文件名
GetPathToRng [C3], ThisWorkbook.Path, , False, True '返回所有文件夹名
GetPathToRng [D3], ThisWorkbook.Path, "*VBA*" '返回所有包含vba的文件名
End Sub

复制代码

遍历文件夹及子文件夹,返回文件列表数组-傻瓜版通用函数.rar (50.22 KB, 下载次数: 3422)

闻启学 · 发表于 2014-4-28 22:52

学习了百度哥多谢分享

dajiahaoxinku12 · 发表于 2014-4-28 23:18

感谢楼主分享，学习了

aman1516 · 发表于 2014-7-23 10:58

谢谢整理分享

wd815 · 发表于 2014-8-5 10:04

Set rng = [a1].Resize(UBound(arr) + 1)
为什么你发的东西都用不了？

ni57 · 发表于 2014-8-5 10:10

感谢楼主，辛苦了

EXCEL江湖 · 发表于 2014-8-24 20:42

版主，您好，在模仿您的操作时还是不得其法，麻烦您帮忙看看，谢谢！http://club.excelhome.net/thread-1147654-1-1.html

cxw3292008 · 发表于 2014-11-5 21:55

fp = Workbooks("Rawdata.xlsx").Path & "\Rawdata\"
arr = GetAllPath(fp, "*.xml", True, False) 'arr就是所有文件夹下的文件名称数组
For k = 0 To UBound(arr)
msgbox arr(k)
next
请问楼主，为什么我输出的数组内容是这样的。
C:\Users\Administrator\Desktop\5个\Rawdata\cfzj20141029_sales_93272089_1569857341.xml\cfzj20141029_sales_93272089_1569857341.xml
结尾尾巴多个个文件名

谢谢。

百度不到去谷歌 · 发表于 2014-11-5 23:27

本帖最后由百度不到去谷歌于 2014-11-6 08:36 编辑

cxw3292008 发表于 2014-11-5 21:55
fp = Workbooks("Rawdata.xlsx").Path & "\Rawdata\"
arr = GetAllPath(fp, "*.xml", True, False) 'arr ...

最后不要跟\ 注意看我的例子错了还真是bug 我修改一下看来下载的人都没几个好好测试过的
If FileSerch(FileType, File.Name) Then dic.Add File.Path & "\" & File.Name, File.Name
这句改为If FileSerch(FileType, File.Name) Then dic.Add File.Path, File.Name
就可以了

lee1892 · 发表于 2014-11-6 00:28

目前为止我在这个论坛看到的最有意思的办法是这个：http://club.excelhome.net/forum. ... 698&pid=6639349

楼主参考一下

		自动登录	找回密码
密码			免费注册

[原创] 超好用的遍历文件夹及子文件夹,返回文件列表数组,可搜索文件类型,傻瓜版通用VBA函数

评分