[AccessD] Grab Filenames

 Here is some rough test code I used for a rough timing test of two 
different methods
of finding files ( FileSys and Dir recursion)
I found them about equal (within 1 or 2 seconds) on moderate sized 
directories
But on a full disk search (c:\) over 10 Gigs, the  time was 3 minutes 
for Dir method
(you get 3 or 4 errors thrown up as well) and 1 minute for filesys method.

-------------------------

Dim fso As New FileSystemObject
Dim fld As Folder
' need reference to scrrun.dll scripting runtime
' use FileSys object
Function searchFiles(sDir As String, sSrchString As String)
'searchFiles("c:\Documents and Settings","*.mdb")
'searchFiles("c:\Access Files","*.mdb")
   Dim nDirs As Long
   Dim nFiles As Long
   Dim lSize As Currency
   Dim startTime As Date
   Dim finishTime As Date
      nFiles = 0
      nDirs = 0
      startTime = Now()
  ' sDir = InputBox("Type the directory that you want to search for", _
  '                 "FileSystemObjects example", "C:\")
  ' sSrchString = InputBox("Type the file name that you want to search 
for", _
  '                 "FileSystemObjects example", "vb.ini")
   'MousePointer = vbHourglass
  ' Label1.Caption = "Searching " & vbCrLf & UCase(sDir) & "..."
   lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
   'MousePointer = vbDefault
   Debug.Print Str(nFiles) & " files found in" & Str(nDirs) & _
          " directories", vbInformation
   Debug.Print "Total Size = " & lSize & " bytes"
    finishTime = Now()
      Debug.Print "no of seconds=" & DateDiff("s", startTime, finishTime)
End Function

Private Function FindFile(ByVal sFol As String, sFile As String, _
   nDirs As Long, nFiles As Long) As Currency
   Dim tFld As Folder, tFil As File, FileName As String
  
   On Error GoTo Catch
   Set fld = fso.GetFolder(sFol)
   FileName = Dir(fso.BuildPath(fld.path, sFile), vbNormal Or _
                  vbHidden Or vbSystem Or vbReadOnly)
   While Len(FileName) <> 0
      FindFile = FindFile + FileLen(fso.BuildPath(fld.path, _
      FileName))
      nFiles = nFiles + 1
      'List1.AddItem fso.BuildPath(fld.path, FileName)
      ' Load ListBox or Table
      FileName = Dir()  ' Get next file
      DoEvents
   Wend
 '  Label1 = "Searching " & vbCrLf & fld.path & "..."
   nDirs = nDirs + 1
   If fld.SubFolders.Count > 0 Then
      For Each tFld In fld.SubFolders
         DoEvents
         FindFile = FindFile + FindFile(tFld.path, sFile, nDirs, nFiles)
      Next
   End If
   Exit Function
Catch:  FileName = ""
       Resume Next
End Function


---------------------------------

'testfind("c:\Documents and Settings","*.mdb")
'testfind("c:\Access Files","*.mdb")
       Function testfind(SearchPath As String, FindStr As String)
' Use Dir recursion     
      Dim FileSize As Long
      Dim NumFiles As Integer, NumDirs As Integer
      Dim startTime As Date
      Dim finishTime As Date
      NumFiles = 0
      NumDirs = 0
      startTime = Now()
      FileSize = FindFiles(SearchPath, FindStr, NumFiles, NumDirs)
      Debug.Print NumFiles & " Files found in " & NumDirs + 1 & _
         " Directories"
      Debug.Print "Size of files found under " & SearchPath & " = " & _
         Format(FileSize, "#,###,###,##0") & " Bytes"
      finishTime = Now
      Debug.Print "no of seconds=" & DateDiff("s", startTime, finishTime)
      End Function

 Function FindFiles(path As String, SearchStr As String, _
       FileCount As Integer, DirCount As Integer)
      Dim FileName As String   ' Walking filename variable.
      Dim DirName As String    ' SubDirectory Name.
      Dim dirNames() As String ' Buffer for directory name entries.
      Dim nDir As Integer      ' Number of directories in this path.
      Dim i As Integer         ' For-loop counter.

      On Error GoTo sysFileERR
      If Right(path, 1) <> "\" Then path = path & "\"
      ' Search for subdirectories.
      nDir = 0
      ReDim dirNames(nDir)
      DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or 
vbReadOnly _
                  Or vbSystem)  ' Even if hidden, and so on.
      Do While Len(DirName) > 0
         ' Ignore the current and encompassing directories.
         If (DirName <> ".") And (DirName <> "..") Then
            ' Check for directory with bitwise comparison.
            If GetAttr(path & DirName) And vbDirectory Then
               dirNames(nDir) = DirName
               DirCount = DirCount + 1
               nDir = nDir + 1
               ReDim Preserve dirNames(nDir)
               'List2.AddItem path & DirName ' Uncomment to list
            End If                           ' directories.
sysFileERRCont:
         End If
         DirName = Dir()  ' Get next subdirectory.
      Loop

      ' Search through this directory and sum file sizes.
      FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbSystem _
      Or vbReadOnly Or vbArchive)
      While Len(FileName) <> 0
         FindFiles = FindFiles + FileLen(path & FileName)
         FileCount = FileCount + 1
         ' Load List box or table
        ' List2.AddItem path & FileName & vbTab & _
        '    FileDateTime(path & FileName)   ' Include Modified Date
         FileName = Dir()  ' Get next file.
      Wend

      ' If there are sub-directories..
      If nDir > 0 Then
         ' Recursively walk into them
         For i = 0 To nDir - 1
           FindFiles = FindFiles + FindFiles(path & dirNames(i) & "\", _
            SearchStr, FileCount, DirCount)
         Next i
      End If

AbortFunction:
     ' Debug.Print "abort function=" & DirName
     ' will pass through here on end of recursion
      Exit Function
sysFileERR:
       Debug.Print "Unexpected Error=" & Err.Number & "name=" & FileName 
& "-" & DirName & Right(DirName, 4)
      If Right(DirName, 4) = ".sys" Then
        Debug.Print "pagefile.sys"
        Resume sysFileERRCont ' Known issue with pagefile.sys
       
      Else
        MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
         "Unexpected Error" & FileName & "-" & DirName
         Debug.Print "resume"
        Resume AbortFunction
      End If
      End Function