分类
VBA

VBA应用——遍历文件夹及其子文件夹

经常使用excel来进行数据统计和汇总分析的我们有时候需要将很多年份的数据进行汇总,如果我们使用VBA来帮助我们汇总,将会节约我们很多的时间。

如果需要汇总的文件都在一个文件夹中而不存在子文件夹,我们可以在网上找到很多简单的代码,告诉我们用VBA提供的Dir函数来获取文件列表。但如果我们需要汇总的文件有一些在子文件夹中,我们使用Dir来获取文件列表的方法就不太好用了。

怎么办呢?

下面,阁主呈上一份能够遍历文件夹及子文件夹获取文件列表的代码,以飨读者。

Function getFileList(Optional ByVal dirStr As String) As Collection
    Dim tmpStr As String, fileCollection As Collection '定义一个集合,来存放Dir出来的文件或文件夹名称
    '如果路径不带“\”,则加上
    If Right(dirStr, 1) <> "\" Then
        dirStr = dirStr & "\"
    End If
    '第一次Dir,遍历目录,并将文件或文件夹名称存入集合
    on error Resume next
    tmpStr = Dir(dirStr, vbDirectory)
    If Err.Number <> 0 Then
        Set getFileList = Nothing
        Exit Function
    End If
    on error goto 0
    Set fileCollection = New Collection
    While (tmpStr <> "")
        If tmpStr <> "." And tmpStr <> ".." Then
            fileCollection.Add (dirStr & tmpStr)
        End If
        tmpStr = Dir
    Wend
    '针对上述遍历出的文件或文件夹名称,递归遍历子目录
    Dim i
    i = 1
    While i <= fileCollection.Count
    '遍历刚才获取到的目录内文件夹和文件列表,递归调用本函数实现对子目录的遍历。
        On Error Resume Next
        Dim tmparr
        If fileCollection.Item(i) <> dirStr & "" And fileCollection.Item(i) <> dirStr & "." And fileCollection.Item(i) <> dirStr & ".." Then
            Set tmparr = getFileList(fileCollection.Item(i)) '递归调用,下一层目录
            If Err.Number = 0 Then
                
                Dim k, l
                l = i
                For k = 1 To tmparr.Count
                    fileCollection.Add tmparr(k), after:=l
                    l = l + 1
                Next k
                i = l
            Else
                Err.Clear
            End If
        End If
        On Error GoTo 0
        i = i + 1
    Wend
    Set getFileList = fileCollection
End Function

食用方法:

函数返回了一个Collection对象,可以通过遍历Collection对象的值来获得目录和文件列表。

Sub test()
    Dim s
    Set s = getFileList("d:\xx文件夹")
    Dim k
    For Each k In s
        Debug.Print k
    Next k
End Sub

 

“VBA应用——遍历文件夹及其子文件夹”上的2条回复

评论已关闭。