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

2015年10月19日09:20:20 评论 3,828 views
摘要

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

表格 定制  数据 合并 处理 分析 VBA 编程 开发 网页
表格 定制  数据 合并 处理 分析 VBA 编程 开发 网页

最近看到很多人问遍历文件的问题,其实百度上很多,还有些人在用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 

  • 郑广学老师微信号
  • EXCEL880A
  • weinxin
  • 我的微信公众号
  • EXCEL880
  • weinxin

发表评论

您必须才能发表评论!