VB Quicktakes - Recursive File Search

Use the code below to run a recursive directory search. Place this code in a module and call the FindFile function. This file should be passed the path to be searched, the filename to be found and a string array which will contain all the relevant paths.

Option Explicit

'Windows API/Global Declarations for :Fi
'     ndFile
Public Const MAX_PATH = 260

Type FILETIME ' 8 Bytes
    dwLowDateTime As Long
    dwHighDateTime As Long
    End Type

Type WIN32_FIND_DATA ' 318 Bytes
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved_ As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
    End Type

Public Declare Function FindFirstFile& Lib "kernel32" _
    Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _

Public Declare Function FindClose Lib "kernel32" _
    (ByVal hFindFile As Long) As Long

Private Declare Function FindNextFile Lib "kernel32" _
    Alias "FindNextFileA" (ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function PathMatchSpec Lib "Shlwapi" _
   Alias "PathMatchSpecW" (ByVal pszFileParam As Long, _
   ByVal pszSpec As Long) As Boolean

Public Function FindFile(path As String, Filename As String, strFileList() As String) As Boolean Dim fdata As WIN32_FIND_DATA, hFind As Long, curFile As String, retPath As String Dim AddFile As Boolean If Right(path, 1) <> "\" Then path = path & "\" End If hFind = FindFirstFile(path & "*.*", fdata) If hFind = 0 Then ' no files found FindFile = "" Exit Function End If Do curFile = Left$(fdata.cFileName, InStr(fdata.cFileName, Chr$(0))) ' If it's a directory If fdata.dwFileAttributes And vbDirectory And _ curFile <> "." + vbNullChar And curFile <> ".." + vbNullChar Then retPath = FindFile(Left(path & curFile, Len(path & curFile) - 1), Filename, strFileList) If retPath <> "" Then FindFile = retPath End If Else ' If it's a file If MatchSpec(curFile, Filename) Then FindFile = True If Isdimmed(strFileList) Then ReDim Preserve strFileList(UBound(strFileList) + 1) strFileList(UBound(strFileList)) = path & curFile Else ReDim strFileList(0) strFileList(0) = path & curFile End If Exit Function End If End If DoEvents Loop While FindNextFile(hFind, fdata) hFind = FindClose(hFind) End Function
Public Function MatchSpec(File As String, Spec As String) As Boolean ' Returns True if the file name matches a wildcard match ' type (e.g. "*.doc"). MatchSpec = PathMatchSpec(StrPtr(File), StrPtr(Spec)) End Function
About this page: