1、遍历文件

我们在VBA中遍历获取所有文件的方法一般是使用下面3种：

• 调用Dir函数
• 使用FileSystemObject
• 使用cmd命令

Dir方法是VBA里封装好了的，但是对于判段是否是文件夹并没有很好的方法，一般是利用文件名是否包含“.”来判断，但这个是很不严谨的。

不过这个方法其实和Windows API的使用方法很相近，只是他的返回值太单一了一点：

Sub TestVBADir()
    VBADirR "path\"
End Sub
Function VBADirR(strdir As String) As Long
    Dim fn As String
    fn = VBA.Dir(strdir & "\*", vbDirectory)
    Do Until fn = ""
        If fn <> "." And fn <> ".." Then
            Debug.Print fn
        End If
        fn = VBA.Dir()
End Function

FileSystemObject方法是对象形式的，好理解。

cmd命令最简单，用dir命令就可以。

这2种方法我在 VBA汇总多个Excel文件数据 里使用过。

这些方法的底层应该都是调用了Windows API来实现，让我们看看如何直接使用Windows API来实现遍历文件。

2、代码实现

主要使用的是FindFirstFile和FindNextFile2个API：

Const MAX_PATH As Long = 260
Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800
Private Const FILE_ATTRIBUTE_DEVICE As Long = &H40
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const FILE_ATTRIBUTE_ENCRYPTED As Long = &H4000
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_ATTRIBUTE_NOT_CONTENT_INDEXED As Long = &H2000
Private Const FILE_ATTRIBUTE_OFFLINE As Long = &H1000
Private Const FILE_ATTRIBUTE_READONLY As Long = &H1
Private Const FILE_ATTRIBUTE_REPARSE_POINT As Long = &H400
Private Const FILE_ATTRIBUTE_SPARSE_FILE As Long = &H200
Private Const FILE_ATTRIBUTE_SYSTEM As Long = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100
Sub ScanDir()
    ScanDirR "path\*"
End Sub
Function ScanDirR(lpFileName As String) As Long
    Dim hFindFile As Long
    Dim fd As WIN32_FIND_DATA
    hFindFile = FindFirstFile(lpFileName, fd)
    If hFindFile = INVALID_HANDLE_VALUE Then
        Debug.Print lpFileName, "FindFirstFile出错"
        Exit Function
    End If
    Dim path As String
    path = VBA.Left$(lpFileName, VBA.InStrRev(lpFileName, "\"))
    Dim ret As Long
    ret = 1
    '返回的文件名中会包含"."和".."
    '“.'代表本目录，".."代表上一层目录
    '一般情况下需要把这两个名称过滤掉
    Dim tmp As String
    Do While ret
        tmp = GetFileName(fd.cFileName)
        If tmp <> "." And tmp <> ".." Then
            If fd.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then
                ScanDirR path & tmp & "\*"
                '输出文件名中包含“xls”的文件
                If tmp Like "*xls*" Then Debug.Print path & tmp, VBA.Hex(fd.dwFileAttributes)
            End If
        End If
        ret = FindNextFile(hFindFile, fd)
    FindClose hFindFile
End Function
'去除多余的空字符
Function GetFileName(str As String) As String
    Dim index As Long
    index = VBA.InStr(str, VBA.Chr(0))
    If index Then