课程咨询 加我微信EXCEL880B 试学网址http://v.excel880.com
最近看到很多人问遍历文件的问题,其实百度上很多,还有些人在用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
