ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 19953|回复: 29

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

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2014-4-28 22:36 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:文件操作和FSO
本帖最后由 百度不到去谷歌 于 2014-4-28 22:45 编辑

最近看到很多人问遍历文件的问题,其实百度上很多,还有些人在用dir,dir对文件名有诸多限制的
还是跟着微软用FileSystemObject吧,我整理了一下代码,封装成一个通用函数,
调用的时候只需要直接导入Mfiles模块 或者复制代码到新模块
根据需要调整参数即可,希望下次有人再需要的时候能百度到我这里,也少走一些弯路
闲话少上 代码表格奉上
  1. '-----------Function GetAllPath----------百度不到去谷歌 QQ80871835 2014/4/28---------------------------
  2. '功能 :'遍历path目录,返回所有文件名或者文件夹名数组,可选长短路径,可选文件类型,可选文件夹或文件
  3. '变量 :path      string  -文件夹路径
  4. 'op    FileType  string  -文件类型,可用*.*来匹配特定文件类型,或者直接*x*模糊搜索文件及文件夹也可
  5. 'op    Fullname  Boolean -是否返回完整路径,默认为true返回完整
  6. 'op    IsFolder  Boolean  -返回文件还是文件夹,true为文件夹,false为文件,默认是文件
  7. '      示例:  MsgBox "返回xls和txt文件全路径" & vbNewLine & Join(GetAllPath(ThisWorkbook.Path, "*.xls|*.txt"), vbNewLine)
  8. '--------------------------------------------------------------------------------------------------
  9. Function GetAllPath(Path$, Optional FileType$ = "*", _
  10.                     Optional FullName As Boolean = True, Optional IsFolder As Boolean = False)
  11.     Dim dic As Object, i&, Fso As Object, Folder As Object
  12.     Set dic = CreateObject("Scripting.Dictionary") '字典key存放路径,item存放名字
  13.     Set Fso = CreateObject("Scripting.FileSystemObject")
  14.     Set Folder = Fso.GetFolder(Path)
  15.     i = 1
  16.     Call GetPath(Folder, dic, FileType, IsFolder)
  17.     If FullName Then
  18.         GetAllPath = dic.keys '返回文件名
  19.     Else
  20.         GetAllPath = dic.items '返回完整路径带文件名
  21.     End If
  22.     Set Folder = Nothing: Set Fso = Nothing
  23. End Function
  24. Private Sub GetPath(ByVal Folder As Object, dic, Optional FileType$ = "*", Optional ByVal IsFolder As Boolean = False)
  25.     Dim SubFolder As Object '遍历文件夹及子文件夹获取对应搜索列表的文件
  26.     Dim File As Object, i&, arr
  27.     If IsFolder Then '返回文件夹路径
  28.         For Each SubFolder In Folder.SubFolders
  29.             If FileSerch(FileType, SubFolder.Name) Then dic.Add SubFolder.Path, SubFolder.Name
  30.             Call GetPath(SubFolder, dic, FileType, IsFolder)  '递归调用子文件夹
  31.         Next
  32.     Else '遍历文件,返回文件路径
  33.         For Each File In Folder.Files    '遍历文件
  34.             If FileSerch(FileType, File.Name) Then dic.Add File.Path & "" & File.Name, File.Name
  35.             '搜索列表,多个匹配项用|分隔,可用户自由发挥,常用与匹配文件类型,也可用于搜索包含关键字文件
  36.         Next
  37.         For Each SubFolder In Folder.SubFolders
  38.             Call GetPath(SubFolder, dic, FileType, IsFolder)   '递归调用子文件夹
  39.         Next
  40.     End If
  41. End Sub
  42. Private Function FileSerch(FileType$, fname$) As Boolean
  43.     Dim arr, i&
  44.     arr = Split(FileType, "|") '搜索列表,多个匹配项用|分隔,可用户自由发挥,常用与匹配文件类型,也可用于搜索包含关键字文件
  45.     For i = 0 To UBound(arr)
  46.         If fname Like arr(i) Then FileSerch = True: Exit Function '匹配到其中一项即退出判断
  47.     Next
  48. End Function-
复制代码
使用示例
  1. Public Sub rngtest() '当前目录下
  2.     [A3:E65536] = ""
  3.     GetPathToRng [A3], ThisWorkbook.Path, "*.xls|*.txt" '返回xls和txt文件全路径
  4.     GetPathToRng [B3], ThisWorkbook.Path, , False '返回所有文件名
  5.     GetPathToRng [C3], ThisWorkbook.Path, , False, True '返回所有文件夹名
  6.     GetPathToRng [D3], ThisWorkbook.Path, "*VBA*" '返回所有包含vba的文件名
  7. End Sub
复制代码
遍历文件.gif

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

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-4-28 22:52 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
学习了 百度哥 多谢分享

TA的精华主题

TA的得分主题

发表于 2014-4-28 23:18 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
感谢楼主分享,学习了               

TA的精华主题

TA的得分主题

发表于 2014-7-23 10:58 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2014-8-5 10:04 | 显示全部楼层
Set rng = [a1].Resize(UBound(arr) + 1)
为什么你发的东西都用不了?

TA的精华主题

TA的得分主题

发表于 2014-8-5 10:10 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2014-8-24 20:42 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
版主,您好,在模仿您的操作时还是不得其法,麻烦您帮忙看看,谢谢!http://club.excelhome.net/thread-1147654-1-1.html

TA的精华主题

TA的得分主题

发表于 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
结尾尾巴多个个文件名

谢谢。

TA的精华主题

TA的得分主题

 楼主| 发表于 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
就可以了

TA的精华主题

TA的得分主题

发表于 2014-11-6 00:28 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
目前为止我在这个论坛看到的最有意思的办法是这个:http://club.excelhome.net/forum. ... 698&pid=6639349

楼主参考一下
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 16:56 , Processed in 0.048616 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表