具有子目录的最佳查找文件

Option Explicit
[color=red]Public[/color] Sub Test ( )
    Dim foldername As String, _
        filespec   As String, _
        var        As Variant
        
    foldername = "c:\windows\temp"
    
[color=green]    ''  you could use this to reduce the initial scan results[/color]
    
    filespec = "*.*"
    
[color=green]    ''  in a real world app you'd want to set the result to a collection 
    ''  and then test the count before attempting to iterate it[/color]
    
    For Each var In GetAllFiles(foldername, filespec, True)
        
        Debug.Print var
        
[color=green]        ''  do your final file matching code here if filespec doesn't nail it[/color]
        
    Next var
End Sub
[color=blue]Public[/color] Function GetAllFiles(foldername As String, filespec As String, recurse As Boolean) As Collection
    Dim result As New Collection
        
    Call GetAllFilesEx(foldername, filespec, recurse, result)
    
    Set GetAllFiles = result
End Function
[color=red]Private[/color] Sub GetAllFilesEx(foldername As String, _
                          filespec As String, _
                          recurse As Boolean, _
                          ByRef result As Collection)
    DoEvents
    Dim filename As String, _
        fullname As String, _
        folder   As Variant, _
        folders  As New Collection        
        
    If recurse Then
    
[color=green]        ''  get any folders[/color]
        
        filename = Dir$(foldername & "\*.*", vbDirectory)
        
        Do While filename  ""
            If filename = "." Then GoTo Iterate
            If filename = ".." Then GoTo Iterate
            fullname    = foldername & "" & filename
            If GetAttr(fullname) And vbDirectory Then
                folders.Add fullname
            End If
Iterate:
            filename = Dir$
        Loop
        
    End If
    
[color=green]    ''  get the files[/color]
    
    filename = Dir$(foldername & "" & filespec, vbHidden)
    
    Do While filename  ""
        fullname = foldername & "" & filename
        result.Add fullname
        filename = Dir$
    Loop
    
    For Each folder In folders
        Call GetAllFilesEx(CStr(folder), filespec, recurse, result)
    Next folder
End Sub

Option Explicit
Private Const vbDot = 46
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const vbBackslash = ""
Private Const ALL_FILES = "*.*"
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private 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 FindClose Lib "kernel32" _
    (ByVal hFindFile As Long) As Long
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 lstrlen Lib "kernel32" _
    Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function PathMatchSpec Lib "shlwapi" _
    Alias "PathMatchSpecW" (ByVal pszFileParam As Long, _
    ByVal pszSpec As Long) As Long
Dim sFileExt As String
Dim sFileRoot As String
Public Sub FindAllFiles(FileType As String, StartPath As String)
    ' recursively searches a passed path for files of a given type
    ' FileType: a wildcard string of the file extension, ie; "*.dwg" or "*.xls"
    ' calls "DoSomethingWithFile" subroutine to execute your own code on each found file
    
    sFileRoot = QualifyPath(StartPath) 'start path
    sFileExt = FileType 'file type of interest
    
    Call SearchForFiles(sFileRoot)
End Sub
Private Sub SearchForFiles(sRoot As String)
    Dim WFD As WIN32_FIND_DATA
    Dim hFile As Long
    
    hFile = FindFirstFile(sRoot & ALL_FILES, WFD)
    
    If hFile  INVALID_HANDLE_VALUE Then
        
        Do
        'if a folder, and recurse specified, call method again
        If (WFD.dwFileAttributes And vbDirectory) Then
            If Asc(WFD.cFileName)  vbDot Then
                SearchForFiles sRoot & TrimNull(WFD.cFileName) & vbBackslash
            End If
        Else
            'must be a file..
            If MatchSpec(WFD.cFileName, sFileExt) Then
                DoSomethingWithFile sRoot & TrimNull(WFD.cFileName)
            End If 'If MatchSpec
        End If 'If WFD.dwFileAttributes
        
        Loop While FindNextFile(hFile, WFD)
    End If 'If hFile
    
    Call FindClose(hFile)
End Sub
Private Function QualifyPath(sPath As String) As String
    ' formats passed path string to be used in recursive API search
    If Right$(sPath, 1)  vbBackslash Then
        QualifyPath = sPath & vbBackslash
    Else
        QualifyPath = sPath
    End If
End Function
Private Function TrimNull(startstr As String) As String
    ' trims NULL char (ascii 0) from strings returned by API calls
    TrimNull = Left$(startstr, lstrlen(StrPtr(startstr)))
End Function
Private Function MatchSpec(sFile As String, sSpec As String) As Boolean
    ' uses API version of the "LIKE" command
    MatchSpec = PathMatchSpec(StrPtr(sFile), StrPtr(sSpec))
End Function
Private Sub DoSomethingWithFile(FoundFileName As String)
    ' use this routine to do something with each file found
    ' we'll do nothing but print out the filename found
    Dim FoundName As String: FoundName = FoundFileName
    
    Debug.Print FoundName
End Sub