ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
高效办公必会的Office实战技巧 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel函数公式学习大典 Office 365免费试用,报名现在开始! 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 打造核心竞争力的职场宝典 13门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 56555|回复: 263

[分享] 跟我学 【喜迎2015立春】遍历文件夹(含子文件夹)方法 ABC

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2015-2-4 08:53 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:文件操作和FSO
本帖最后由 香川群子 于 2015-2-5 09:37 编辑

遍历文件夹内所有文件、
遍历文件夹内所有指定类型的文件、
遍历文件夹内所有指定名称的文件、

遍历文件夹内所有子文件夹、

遍历文件夹以及所有子文件夹内所有文件、
遍历文件夹以及所有子文件夹内所有指定类型的文件、
遍历文件夹以及所有子文件夹内所有指定名称的文件、

…………
上面的要求,是一个永恒的话题。
尤其是新手VBA初学者,往往会在不同阶段开始涉及此类要求。

…………
EH论坛中搜索一下,会有一大堆的实际应用例子。
也早已有热心的高手,做了代码优化……写成了标准的自定义函数或过程。

做法基本上有2大类:
① 经典Dir
② FSO
即 Scripting.FileSystemObject 的【文件系统对象】脚本方法。

一开始可能Dir方法较为普遍,但随着水平的提高,应用FSO方法因为有更多的好处而更为流行。

我会在本帖详细介绍这二种方法、并且是适合初学者的、循序渐进的方法。
以便大家迅速掌握,并消化吸收以后进入自己的知识库。

最后,我还会向大家介绍第三种方法:在VBA中使用Dos的Dir命令的高效遍历子文件夹中所有指定文件的方法。

由于有这个特色,所以我觉得单独开帖是有必要的,我的这个【遍历子文件夹方法】的帖子,将成为经典。
补充:由于Application.FileSearch方法仅能用于2003版,以后的版本不再能使用此方法,所以就无需介绍了。



代码介绍完毕,初步总结一下:
① Dos Dir 方法最快,但是只能提取全部文件、文件夹名后输出到工作表,无法在中途进行具体文件的选择处理。
② VBA Dir 方法比较容易学习、理解。(简单的Do 循环即可) 但中间需要判断区分文档和文件夹,代码结构稍复杂。
③ FSO方法 是综合性能最好的。 其实掌握基本概念以后非常好用。 递归、字典、数组 三个方法的代码,请大家各取所需灵活运用。


对本帖有任何问题或要求,欢迎随时跟帖、提问。




评分

参与人数 46财富 +180 鲜花 +90 技术 +2 收起 理由
sjh4030 + 2 优秀作品
小行星B612 + 2 太强大了
ljpmqb888 + 2 太强大了
chenrh007 + 2 太强大了
三流高手 + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-2-4 09:14 | 显示全部楼层
首先要介绍,在VBA代码运行以后,调用【目标文件夹】的方法:

① 微软Excel VBA 默认选择文件夹的Dialog对话框
  1. Sub ListFilesTest()
  2.     With Application.FileDialog(msoFileDialogFolderPicker) '运行后出现标准的选择文件夹对话框        
  3.         If .Show Then myPath = .SelectedItems(1) Else Exit Sub '如选中则返回=-1 / 取消未选则返回=0
  4.     End With
  5.     If Right(myPath, 1) <> "" Then myPath = myPath & ""
  6.     '返回的是选中目标文件夹的绝对路径,但除了本地C盘、D盘会以"C:"形式返回外,其余路径无""需要自己添加
  7. End Sub
复制代码
② 视窗浏览器界面选择目标文件夹
  1. Sub ListFilesTest()
  2.     Set myFolder = CreateObject("Shell.Application").BrowseForFolder(0, "GetFolder", 0)
  3.     If Not myFolder Is Nothing Then myPath$ = myFolder.Items.Item.Path Else MsgBox "Folder not Selected": Exit Sub
  4.     If Right(myPath, 1) <> "" Then myPath = myPath & ""
  5.     '同样返回的是选中目标文件夹的绝对路径,但除了本地C盘、D盘会以"C:"形式返回外,其余路径无""需要添加

  6. End Sub
复制代码
…………
这两种选择目标文件夹的方法,总的效果应该都不错。
方法-1 默认Dialog对话框左侧栏有桌面、我的文档等快捷方式,也比较符合一般人的使用习惯。
优点是,本层文件夹内的子文件夹全部以大图标方式列出(也可以改为列表)看起来较为轻松。
缺点是,如果有多层子文件夹,需要一层一层地点下去……似乎比较累一点。

与此相对、方法-2 是浏览器形式,点击+号可以展开、点击-号可以折叠。
因此也有很多人特别喜欢这一种的,尤其是有多层子文件夹时很方便。


…………
因此,这两种方法你喜欢哪一种都可以,可以多试几次然后定下来。

呵呵。这是本帖第一宝。

评分

参与人数 3鲜花 +6 收起 理由
hcy1185 + 2 我喜欢!运行代码弹出选择盘符或文件夹的窗.
shanchuan + 2 优秀作品
唐伯狼 + 2 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-2-4 09:32 | 显示全部楼层
接下来,直接介绍当前流行的、高大上的FSO方法。

由简到繁地介绍:

一、仅列出目标文件夹中所有文件。(不包括 子文件夹、不包括子文件夹中的文件)
  1. Sub ListFilesTest()
  2.     With Application.FileDialog(msoFileDialogFolderPicker)
  3.         If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
  4.     End With
  5.     If Right(myPath, 1) <> "" Then myPath = myPath & ""
  6.     '以上选择目标文件夹以得到路径myPath

  7.     MsgBox ListFiles(myPath)    '调用FSO的ListFiles过程返回目标文件夹下的所有文件名
  8.    
  9. End Sub

  10. Function ListFiles(myPath$)
  11.    Set fso = CreateObject("Scripting.FileSystemObject") '打开FSO脚本、建立FSO对象实例
  12.    For Each f In fso.GetFolder(myPath).Files  '用FSO方法遍历指定文件夹内所有文件
  13.       i = i + 1: s = s & vbCr & f.Name            '逐个列出文件名并统计文件个数 i
  14.    Next
  15.    ListFiles = i & " Files:" & s  '返回所有文件名的合并字符串
  16. End Function
复制代码
本代码只是一个简单的示例,大家理解以后,就可以改编为任何自己希望的操作代码,
实现对指定目标文件夹内所有文件的遍历。

…………怎么样?特别容易、特别简单吧?

知识介绍:
Set fso = CreateObject("Scripting.FileSystemObject")
建立FSO 即【文件系统对象】的实例。

这以后,即可简单、直接地引用fso的各种属性(有时间可以自己慢慢研究)

For Each f In fso.GetFolder(myPath).Files
'用FSO方法遍历指定文件夹内所有文件

fso.GetFolder(myPath) 是指对于路径myPath,使用FSO对象方法得到其文件夹.GetFolder属性
然后,对于这个指定的目标文件夹,继续返回其所有文件的属性、即.Files
完整的部分为:  fso.GetFolder(myPath).Files

然后,对于这个所有文件的集合即 fso.GetFolder(myPath).Files
通过For……Each循环就可以遍历其中每一个文件了。

具体地,For Each f In 中的f变量,即为每一个文件。
循环中,可以使用f的各种属性。 f.Name只是其中的一种属性=文件名。

评分

参与人数 3鲜花 +7 收起 理由
aoe1981 + 3 优秀作品
Pan嗯嗯 + 2 太强大了
autumnalRain + 2 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-2-4 09:38 | 显示全部楼层
二、仅列出目标文件夹中所有子文件夹名。(不包括目标文件夹中文件、不包括子文件夹中的文件或子文件夹)
  1. Sub ListFilesTest()
  2.     With Application.FileDialog(msoFileDialogFolderPicker)
  3.         If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
  4.     End With
  5.     If Right(myPath, 1) <> "" Then myPath = myPath & ""
  6.    
  7.     MsgBox ListFolders(myPath)
  8.    
  9. End Sub
  10. Function ListFolders(myPath$)
  11.    Set fso = CreateObject("Scripting.FileSystemObject")
  12.    For Each f In fso.GetFolder(myPath).SubFolders
  13.       j = j + 1: t = t & vbCr & f.Name
  14.    Next
  15.    ListFolders = j & " Folders:" & t
  16. End Function
复制代码
和楼上的代码ListFiles相比,差异很小,仅在于:
fso.GetFolder(myPath).Files
fso.GetFolder(myPath).SubFolders

即,把目标文件夹fso.GetFolder(myPath)的属性,
有.Files 所有文件、改为 .SubFolders 所有子文件夹


呵呵。是不是特别简单那?

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-2-4 09:51 | 显示全部楼层
本帖最后由 香川群子 于 2015-2-4 09:52 编辑

下面很快进入正题:

三、遍历目标文件夹内所有文件、以及所有子文件夹中的所有文件。

以下代码仅为示例,可以用,但代码粗糙不足以成为实用程序。
但是可以在此基础上修改为各种可能。
  1. Sub ListFilesTest()
  2.     With Application.FileDialog(msoFileDialogFolderPicker)
  3.         If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
  4.     End With
  5.     If Right(myPath, 1) <> "" Then myPath = myPath & ""
  6.    
  7.     [a:a] = ""                    '清空A列
  8.     Call ListAllFso(myPath)   '调用FSO遍历子文件夹的递归过程
  9.    
  10. End Sub

  11. Function ListAllFso(myPath$) '用FSO方法遍历并列出所有文件和文件夹名的【递归过程】
  12.     Set fld = CreateObject("Scripting.FileSystemObject").GetFolder(myPath)
  13.     '用FSO方法得到当前路径的文件夹对象实例 注意这里的【当前路径myPath是个递归变量】

  14.     For Each f In fld.Files  '遍历当前文件夹内所有【文件.Files】
  15.         [a65536].End(3).Offset(1) = f.Name '在A列逐个列出文件名
  16.     Next

  17.     For Each fd In fld.SubFolders  '遍历当前文件夹内所有【子文件夹.SubFolders】
  18.         [a65536].End(3).Offset(1) = " " & fd.Name & ""  '在A列逐个列出子文件夹名
  19.         Call ListAllFso(fd.Path)       '注意此时的路径变量已经改变为【子文件夹的路径fd.Path】
  20.         '注意重点在这里: 继续向下调用递归过程【遍历子文件夹内所有文件文件夹对象】
  21.     Next
  22. End Function
复制代码
其实、递归是个让代码更简单的好工具、好算法。
因为它可以把相同的过程的代码反复引用而无需重复写出来。……建议不熟悉递归的开始研究一下递归算法。


TA的精华主题

TA的得分主题

 楼主| 发表于 2015-2-4 10:10 | 显示全部楼层
本帖最后由 香川群子 于 2015-2-5 09:42 编辑

由于很多初学者不太能理解递归算法的过程而产生畏难、抵触情绪,
所以下面避开递归,而采用字典记录中间结果的方法,同样来达到遍历所所有子文件的目的:
  1. Sub ListFilesTest()
  2.     With Application.FileDialog(msoFileDialogFolderPicker)
  3.         If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
  4.     End With
  5.     If Right(myPath, 1) <> "" Then myPath = myPath & ""
  6.    
  7.     MsgBox "List Files:" & vbCr & Join(ListAllFsoDic(myPath), vbCr)
  8.     MsgBox "List SubFolders:" & vbCr & Join(ListAllFsoDic(myPath, 1), vbCr)
  9. End Sub

  10. Function ListAllFsoDic(myPath$, Optional k = 0) '使用2个字典但无需递归的遍历过程
  11.     Dim i&, j&
  12.     Set d1 = CreateObject("Scripting.Dictionary") '字典d1记录子文件夹的绝对路径名   
  13.     Set d2 = CreateObject("Scripting.Dictionary") '字典d2记录文件名 (文件夹和文件分开处理)

  14.     d1(myPath) = ""           '以当前路径myPath作为起始记录,以便开始循环检查

  15.     Set fso = CreateObject("Scripting.FileSystemObject")
  16.     Do While i < d1.Count
  17.     '当字典1文件夹中有未遍历处理的key存在时进行Do循环 直到 i=d1.Count即所有子文件夹都已处理时停止

  18.         kr = d1.Keys '取出文件夹中所有的key即所有子文件夹路径 (注意每次都要更新)
  19.         For Each f In fso.GetFolder(kr(i)).Files '遍历该子文件夹中所有文件 (注意仅从新的kr(i) 开始)
  20.             j = j + 1: d2(j) = f.Name
  21.            '把该子文件夹内的所有文件名作为字典Item项加入字典d2 (为防止文件重名不能用key属性)
  22.         Next

  23.         i = i + 1 '已经处理过的子文件夹数目 i +1 (避免下次产生重复处理)
  24.         For Each fd In fso.GetFolder(kr(i - 1)).SubFolders '遍历该文件夹中所有新的子文件夹
  25.             d1(fd.Path) = " " & fd.Name & ""
  26.             '把新的子文件夹路径存入字典d1以便在下一轮循环中处理
  27.         Next
  28.     Loop

  29.     If k Then ListAllFsoDic = d1.Keys Else ListAllFsoDic = d2.Items
  30.     '如果参数=1则列出字典d1中所有子文件夹的路径名 (如使用d1.Items则仅列出子文件夹名称不含路径)
  31.     '如果参数=0则默认列出字典d2中Items即所有文件名

  32. End Function
复制代码
FSO方法到此暂且告一段落(以后我会再贴出较为实用的代码)

请大家慢慢消化吸收,可以自己任意修改,试一试会得到什么……这样才有进步!

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-2-4 11:00 | 显示全部楼层
本帖最后由 香川群子 于 2015-2-4 12:27 编辑

接下来,马不停蹄,向大家介绍标准的Dir搜寻文件、子文件夹的方法。
  1. Sub ListAllDirDicTest()
  2.     With Application.FileDialog(msoFileDialogFolderPicker)
  3.         If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
  4.     End With
  5.     If Right(myPath, 1) <> "" Then myPath = myPath & ""
  6.    
  7.     MsgBox Join(ListAllDirDic(myPath), vbCr) 'GetAllSubFolder's File 列出目标文件夹内含子文件夹内所有文件
  8.     MsgBox Join(ListAllDirDic(myPath, 1), vbCr) 'GetThisFolder's File 列出目标文件夹内所有文件(不含子文件夹)
  9.    
  10.     MsgBox Join(ListAllDirDic(myPath, -1), vbCr) 'GetThisFolder's SubFolder 仅列出目标文件夹内的子文件夹
  11.     MsgBox Join(ListAllDirDic(myPath, -2), vbCr) 'GetAllSubFolder 列出目标文件夹内含子文件夹的所有子文件夹
  12.    
  13.     MsgBox Join(ListAllDirDic(myPath, 1, "tst"), vbCr) 'GetThisFolder's SpecialFile 仅列出文件夹内含关键字文件
  14.     MsgBox Join(ListAllDirDic(myPath, , "tst"), vbCr) 'GetAllSubFolder's SpecialFile 列出子文件夹内含关键字文件
  15.    
  16. End Sub

  17. Function ListAllDirDic(myPath$, Optional sb& = 0, Optional SpFile$ = "")
  18.     '利用Dir方法、以及用2个字典分别记录子文件夹路径和文件名的文件搜寻方法。

  19.     '第1参数【指定路径myPath】必选 为指定目标文件夹的绝对路径

  20.     '第2参数【子文件夹模式sb】为可选 =奇数时只搜寻当前文件夹、=偶数时搜寻所有子文件夹
  21.     '                                      该参数>=0时返回文件名、<0时返回文件夹路径名
  22.     '因此事实上第2参数可以设置这样四种模式:
  23.     '  默认=0时,搜寻所有子文件夹并返回所有文件名
  24.     '        =1时,搜寻当前文件夹并返回所有文件名 (不向下搜寻子文件夹)
  25.     '        =-1时,搜寻当前文件夹并返回子文件夹路径名
  26.     '        =-2时, 搜寻所有子文件夹并返回所有子文件夹路径名

  27.     '第3参数【文件名指定特殊匹配字符SpFile】 可选,返回文件名时用此关键词过滤一下
  28.     '默认留空时,返回全部文件名 (等于没有被过滤掉)
  29.     ' = 某个关键字时,返回符合匹配(即含该关键字)的部分文件名 (有过滤掉不含关键字的文件名)
  30.     ' = .xl 也可这样指定文件类型,返回匹配(该关键字指定文件类型)的部分文件名 (过滤掉其它类型文件名)
  31.    
  32.     Dim i&, j&, myFile$
  33.     Set d1 = CreateObject("Scripting.Dictionary") '定义存放子文件夹路径的字典d1
  34.     Set d2 = CreateObject("Scripting.Dictionary") '定义存放文件名的字典d2
  35.    
  36.     d1(myPath) = " '字典d1初始化记录目标文件夹路径名
  37.     On Error Resume Next
  38.     Do While i < d1.Count
  39.         kr = d1.Keys  '从字典d1中更新提取所有子文件夹
  40.         myFile = Dir(kr(i), vbDirectory) '用Dir方法遍历该子文件夹得到文件或文件夹名 注意从kr(i)开始避免重复
  41.         Do While myFile <> "" 'Dir遍历直到返回空字符串 (即无未被遍历的文件或文件夹了)
  42.             If myFile <> "." And myFile <> ".." Then '如果是"."或".."属性则不用处理
  43.                 If (GetAttr(kr(i) & myFile) And vbDirectory) = vbDirectory Then '判断是文件夹属性时
  44.                     If Err.Number Then Err.Clear Else d1(kr(i) & myFile & "") = ""
  45.                     '#52 文件名Err时忽略(一般为操作系统语言文字环境问题),否则字典d1记录该子文件夹路径
  46.                 Else '如果不是文件夹则为文件
  47.                     If SpFile = "" Then '如未指定关键字
  48.                         j = j +1: d2(j) = myFile '则所有文件名都作为Item项加入字典d2 (不能使用key防止重名文件)
  49.                     Else '否则指定了关键字
  50.                         If InStr(myFile, SpFile) Then j = j +1: d2(j) = myFile
  51.                         '则判断含有指定关键字以后才可作为Item项加入字典d2 (不能使用key防止重名文件)
  52.                     End If
  53.                 End If
  54.             End If
  55.             myFile = Dir '用Dir方法继续搜寻下一个文件或子文件夹
  56.         Loop
  57.         If sb Mod 2 Then Exit Do Else i = i + 1
  58.         '如果第2参数指定为奇数则不用继续检查子文件夹就可退出,
  59.         '否则 i+1避免重复检查然后利用字典d1中的记录,继续检查下一个子文件夹直到全部子文件夹检查完毕
  60.     Loop
  61.     If sb >= 0 Or Len(SpFile) Then ListAllDirDic = d2.Items Else ListAllDirDic = d1.Keys
  62.     '如果第2参数>=0或第3参数有指定则返回d2的Items文件名、否则返回d1的keys子文件夹名
  63. End Function
复制代码
呵呵。

评分

参与人数 3鲜花 +5 收起 理由
小行星B612 + 2 太强大了
沧海一声笑NEW2 + 2
vested + 1 太强大了

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-2-4 12:16 | 显示全部楼层
其实不用字典也可以。但是要使用Redim数组,并不断地更新数组大小……这让代码看上去有点烦。

解释暂略(因为很上面一样的)
  1. Sub ListAllDirTest()
  2.     With Application.FileDialog(msoFileDialogFolderPicker)
  3.         If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
  4.     End With
  5.     If Right(myPath, 1) <> "" Then myPath = myPath & ""
  6.    
  7.     MsgBox Join(ListAllDir(myPath), vbCr) 'GetAllSubFolder's File
  8.     MsgBox Join(ListAllDir(myPath, 1), vbCr) 'GetThisFolder's File
  9.    
  10.     MsgBox Join(ListAllDir(myPath, -1), vbCr) 'GetThisFolder's SubFolder
  11.     MsgBox Join(ListAllDir(myPath, -2), vbCr) 'GetAllSubFolder
  12.    
  13.     MsgBox Join(ListAllDir(myPath, 1, "tst"), vbCr) 'GetThisFolder's SpecialFile
  14.     MsgBox Join(ListAllDir(myPath, , "tst"), vbCr) 'GetAllSubFolder's SpecialFile
  15.    
  16. End Sub

  17. Function ListAllDir(myPath$, Optional sb& = 0, Optional SpFile$ = "")
  18.     Dim i&, j&, k&, myFile$
  19.     ReDim fld(0), file(0) '定义可变数组fld存放子文件夹路径、file存放文件名
  20.    
  21.     fld(0) = myPath '子文件夹初始化写入指定目标文件夹路径
  22.     On Error Resume Next
  23.     Do
  24.         myFile = Dir(fld(i), vbDirectory)
  25.         Do While myFile <> ""
  26.             If myFile <> "." And myFile <> ".." Then
  27.                 If (GetAttr(fld(i) & myFile) And vbDirectory) = vbDirectory Then
  28.                     If Err.Number Then Err.Clear Else j = j + 1: ReDim Preserve fld(j): fld(j) = fld(i) & myFile & ""
  29.                 Else
  30.                     If SpFile = "" Then
  31.                         file(k) = myFile: k = k + 1: ReDim Preserve file(k)
  32.                     Else
  33.                         If InStr(myFile, SpFile) Then file(k) = myFile: k = k + 1: ReDim Preserve file(k)
  34.                     End If
  35.                 End If
  36.             End If
  37.             myFile = Dir
  38.         Loop
  39.         If sb Mod 2 Then Exit Do Else i = i + 1
  40.     Loop Until i > UBound(fld)
  41.     If sb >= 0 Or Len(SpFile) Then ListAllDir = file Else ListAllDir = fld
  42. End Function
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-2-4 12:42 | 显示全部楼层
注意使用字典时,对于【子文件】来说因为是以绝对路径为key所以不用担心有重复。(字典本身也可以去重复)

但是,对于文件名来说,必须考虑在不同的文件夹中存在大量的同名文件,
所以不能直接用文件名作为字典key储存,必须使用计数序号j 作为keys,把文件名作为Item项存入字典,
才能避免文件名重复时不被字典错误覆盖。

呵呵。这个是细节,但是很重要。

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-2-4 12:52 | 显示全部楼层
本帖最后由 香川群子 于 2015-2-7 21:11 编辑

最后,作为本帖的特色,介绍使用VBA语句直接调用Dos中Dir命令来搜寻文件名的方法:
  1. Sub ListFilesDos()
  2.     Set myFolder = CreateObject("Shell.Application").BrowseForFolder(0, "GetFolder", 0)
  3.     If Not myFolder Is Nothing Then myPath$ = myFolder.Items.Item.Path Else MsgBox "Folder not Selected": Exit Sub
  4.    
  5.     myFile$ = InputBox("Filename", "Find File", ".xl")
  6.     '在这里输入需要指定的关键字,可以是文件名的一部分,或指定文件类型如 ".xl"
  7.     tms = Timer
  8.     With CreateObject("Wscript.Shell") 'VBA调用Dos命令
  9.         ar = Split(.exec("cmd /c dir /a-d /b /s " & Chr(34) & myPath & Chr(34)).StdOut.ReadAll, vbCrLf) '所有文档含子文件夹
  10.         '指定Dos中Dir命令的开关然后提取结果 为指定文件夹以及所含子文件夹内的所有文件的含路径全名。
  11.         s = "from " & UBound(ar) & " Files by Search time: " & Format(Timer - tms, " 0.00s") & " in: " & myPath
  12.         '记录Dos中执行Dir命令的耗时
  13.         tms = Timer: ar = Filter(ar, myFile) '然后开始按指定关键词进行筛选。可筛选文件名或文件类型
  14.         Application.StatusBar = Format(Timer - tms, "0.00s") & " Find " & UBound(ar) + IIf(myFile = "", 0, 1) & " Files " & s
  15.         '在Excel状态栏上显示执行结果以及耗时
  16.     End With
  17.     [a:a] = "": If UBound(ar) > -1 Then [a2].Resize(1 + UBound(ar)) = WorksheetFunction.Transpose(ar)
  18.     '清空A列,然后输出结果
  19. End Sub
复制代码
呵呵,Dos命令不仅简洁,而且高效。

追加更正:提去文件个数统计
提取文件结果的数组ar是下标 0开始的1维数组,元素个数应该=UBound(ar)+1 【此处修正+1为ar(0)】
但实际未产生筛选时的文件结果数=UBound(ar) 无需+1 【因为Dos提取时Dir最后1个""也在结果之中】
而当指定筛选参数myFile不为空时,即产生实际筛选以后的数组ar中会排除最后的那个"",所以筛选后的统计文件结果数=UBound(ar) + 1

点评

这段代码看着眼熟的紧......  发表于 2015-2-7 13:55

评分

参与人数 2鲜花 +4 收起 理由
小行星B612 + 2 太强大了
wolfshanw + 2 太强大了

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,每天学会一个新技能

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

GMT+8, 2018-8-21 16:14 , Processed in 0.070575 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

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

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

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