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 _
    As WIN32_FIND_DATA)

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