作者：绿色风
分类：
时间：2022-08-17
浏览：116
楼主
lrlxxqxa |
Q：如何遍历文件夹及其子文件夹中的所有Excel文件？
A：- Sub Test() '使用双字典，旨在提高速度
- Dim MyName, Dic, Did, I, T, F, TT, MyFileName
- Set objShell = CreateObject("Shell.Application")
- Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)
- If Not objFolder Is Nothing Then lj = objFolder.self.Path & "\"
- Set objFolder = Nothing
- Set objShell = Nothing
- T = Timer
- Set Dic = CreateObject("Scripting.Dictionary") '创建一个字典对象
- Set Did = CreateObject("Scripting.Dictionary")
- Dic.Add (lj), ""
- I = 0
- Do While I < Dic.Count
- Ke = Dic.keys '开始遍历字典
- MyName = Dir(Ke(I), vbDirectory) '查找目录
- Do While MyName <> ""
- If MyName <> "." And MyName <> ".." Then
- If (GetAttr(Ke(I) & MyName) And vbDirectory) = vbDirectory Then '如果是次级目录
- Dic.Add (Ke(I) & MyName & "\"), "" '就往字典中添加这个次级目录名作为一个条目
- End If
- End If
- MyName = Dir '继续遍历寻找
- Loop
- I = I + 1
- Loop
- Did.Add ("文件清单"), ""
- For Each Ke In Dic.keys
- MyFileName = Dir(Ke & "*.xls")
- Do While MyFileName <> ""
- Did.Add (Ke & MyFileName), ""
- MyFileName = Dir
- Loop
- Next
- For Each Sh In ThisWorkbook.Worksheets
- If Sh.Name = "XLS文件清单" Then
- Sheets("XLS文件清单").Cells.Delete
- F = True
- Exit For
- Else
- F = False
- End If
- Next
- If Not F Then
- Sheets.Add.Name = "XLS文件清单"
- End If
- Sheets("XLS文件清单").[A1].Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys)
- TT = Timer - T
- MsgBox TT 'Minute(TT) & "分" & Second(TT) & "秒"
- End Sub
 3.rar
|
2楼
feishifan |
已下载，因没有内容，暂时未领略到作用。试试先。 |
3楼
腾蛇飞舞 |
正在为此事发愁呢，谢谢您！ |
4楼
水星钓鱼 |
学习锐版的代码 |
5楼
芐雨 |
 学习 |
6楼
yytax2010 |
只需要，谢谢！ |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一