Finding Files in a Folder, including those in Sub Folders

Finding Files in a Folder, including those in Sub Folders

One of the real advantages of using API calls rather than an equivalent Access function is speed - when the function is going to be called many times, even a fraction of a millsecond's difference per iteration will be noticeable overall. A good example is when you are trying to find a file from Access, including ones that might be in sub-folders, or even sub-sub-folders.

Whilst you could use Dir, or even the FileSystemObject, both of these are much slower than the API, with the FileSystemObject unsurprisingly being the slowest of the three.

Here is a procedure that is designed to be called recursively, using API calls to get matching files in the folder:

Option Compare Database
Option Explicit

Private Declare Function apiFindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
    (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function apiFindClose Lib "kernel32" Alias "FindClose" _
    (ByVal hFindFile As Long) As Long
Private Declare Function apiFindNextFile Lib "kernel32" Alias "FindNextFileA" _
    (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Private Const MAX_PATH = 260
Private Const FILE_ATTRIBUTE_DIRECTORY = 16
Private Const INVALID_HANDLE_VALUE = -1

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

Sub sTest()
    Call sDirRecursion("C:\", "*.mdb")
End Sub

Sub sDirRecursion(ByVal strFolder As String, strFile As String)
    Dim strFileFound As String    ' Matching file
    Dim lngReturn As Long    ' Return value from API call
    Dim lngFileHandle As Long    ' Handle to a file
    Dim typFileFind As WIN32_FIND_DATA    ' Structure to return details about found files
    Dim astrFolders() As String    ' Array to hold subfolders in the current folder
    Dim lngLoop As Long    ' Loop counter
    If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
    ReDim astrFolders(1 To 100)
    lngLoop = 1
'   Firstly get all folders within the current folder into an array, redimensioning if needed
    lngFileHandle = apiFindFirstFile(strFolder & "*.*", typFileFind)
    If lngFileHandle <> INVALID_HANDLE_VALUE Then
        Do
            strFileFound = Left(typFileFind.cFileName, InStr(typFileFind.cFileName, vbNullChar) - 1)
            If (typFileFind.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
                If strFileFound <> "." And strFileFound <> ".." Then
                    astrFolders(lngLoop) = strFolder & strFileFound
                    If lngLoop Mod 100 = 0 Then ReDim Preserve astrFolders(1 To lngLoop + 100)
                    lngLoop = lngLoop + 1
                End If
            End If
            lngReturn = apiFindNextFile(lngFileHandle, typFileFind)
        Loop While lngReturn <> 0
    End If
    lngReturn = apiFindClose(lngFileHandle)
    ReDim Preserve astrFolders(1 To lngLoop)
'   Then get any matching files
    lngFileHandle = apiFindFirstFile(strFolder & strFile, typFileFind)
    If lngFileHandle <> INVALID_HANDLE_VALUE Then
        Do
            strFileFound = Left(typFileFind.cFileName, InStr(typFileFind.cFileName, vbNullChar) - 1)
'   In this example I only output to the immediate window, but you could add the results to an array or to a table
            Debug.Print strFolder & strFileFound
            lngReturn = apiFindNextFile(lngFileHandle, typFileFind)
        Loop While lngReturn <> 0
    End If
    lngReturn = apiFindClose(lngFileHandle)
'   And now loop through the array of subfolders and call this procedure again
    For lngLoop = 1 To UBound(astrFolders) - 1
        Call sDirRecursion(astrFolders(lngLoop), strFile)
    Next lngLoop
End Sub

Top

Last modified at 06/06/2006 14:53:14