VBA使用API_02：遍历文件

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()
    Loop
End Function

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 & "\*"
            Else
                '输出文件名中包含“xls”的文件
                If tmp Like "*xls*" Then Debug.Print path & tmp, VBA.Hex(fd.dwFileAttributes)
            End If
        End If
        ret = FindNextFile(hFindFile, fd)
    Loop
    
    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
        GetFileName = VBA.Left$(str, index - 1)
    Else
        GetFileName = str
    End If
End Function