[求助]如何用VBA遍历指定目录下的所有子文件夹和文件

liusongs · 发表于 2009-6-30 19:48

好贴,好好学习,最好能与文件建立联系(或用超级链接,或用HYPERLINK函数)这样使用就方便了!

chieson · 发表于 2009-7-29 23:00

这段程序大部分时间都是可以顺利运行的，时间也很少，2K多次的运算最多不会超过1分钟。
但是有时候程序会报“文件找不到”的错误（run time error 53), 或者出现 “文件名或文件号错误）（run time error 52) . 有谁知道这是什么原因吗？
所有文件都可以访问，而且我有一次测试中跑了9K多次（文件很多），那次没出什么问题。是不是跟有些文件的类型有关啊？

chieson · 发表于 2009-7-30 22:35

知道什么错误了
run time error 53 : 是因为下面的文件名个别包含双拼或全拼等中文输入法输入的英文或符号。
run time error 52: 是因为个别文件名直接包含了中文

难道dir取文件名时，如果是中文时就会产生？等符号以至出错？（公司的电脑都是用英文的，难道跟系统设置有关？）
但是用段程序在家里的电脑上跑过，结果有时有中文字符时也没有出错。

zldccmx · 发表于 2009-7-30 23:59

我还没有发现问题。
估计是与操作系统有关。
我没有用过英文操作系统，所以没有办法测试

xfliuliu2710 · 发表于 2009-8-28 14:52

这个程序对于建立某文件夹下的所有文件文件目录很有实用价值.若修改为运行程序时由用户自由选择建立某盘下的某文件夹(包含多级子文件夹)内所有文件目录,这就太好了.我是个菜鸟,不知道怎么改.烦哪位大侠帮帮.

yf_992258 · 发表于 2009-8-28 15:30

是对出现 “文件名或文件号“错误
我看了我有一个坛内下载的文件，ʹ ض.rar___200672519564957236.rar
不能识别所以出错了
还有字典+数组比前一种DIR快了没多少，估计数据量大了可能感觉的出来

yf_992258 · 发表于 2009-8-28 15:34

这个程序对于建立某文件夹下的所有文件文件目录很有实用价值.若修改为运行程序时由用户自由选择建立某盘下的某文件夹(包含多级子文件夹)内所有文件目录,这就太好了.我是个菜鸟,不知道怎么改.烦哪位大侠帮帮.

添加一段选择文件夹目录的代码即可
Sub Test() '使用双字典，旨在提高速度
Dim MyName, Dic, Did, I, T, F, TT, MyFileName
'On Error Resume Next
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 ("文件清单"), "" '以查找D盘下所有EXCEL文件为例
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

xfliuliu2710 · 发表于 2009-8-28 16:23

太好了,十分感谢,把这句稍改了下MyFileName = Dir(Ke & "*.*")
就能建立文件夹下所有文件目录了,对建立资料档案非常实用.

xfliuliu2710 · 发表于 2009-8-28 16:48

再请教大灰狼大师一个问题,如何让程序运行后,在A1单元格以及本工作表名称显示为所选择一级文件夹的名称&"文件清单"?如选择的文件夹名称为"2009年农业资料1",则A1和工作表名称为"2009年农业资料1文件清单",麻烦大师了.

[ 本帖最后由 xfliuliu2710 于 2009-8-28 16:56 编辑 ]

fecmen · 发表于 2009-8-28 17:45

老朽很厉害啊！支持！

		自动登录	找回密码
密码			免费注册

[已解决] [求助]如何用VBA遍历指定目录下的所有子文件夹和文件

回复 5楼 zldccmx 的帖子

回复 13楼 chieson 的帖子

回复 5楼 zldccmx 的帖子

回复 18楼 yf_992258 的帖子

回复 18楼 yf_992258 的帖子