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

liusongs

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

chieson

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

chieson

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

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

zldccmx

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

xfliuliu2710

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

yf_992258

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

yf_992258

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

添加一段选择文件夹目录的代码即可
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

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

xfliuliu2710

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

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

fecmen

老朽很厉害啊！支持！