Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private m_lngDirCount As Long
Private m_lngFileCount As Long
Private m_astrFiles() As String
Private m_blnCancel As Boolean

Private m_objFSO As Scripting.FileSystemObject

Private Sub Form_Load()
  lblMsg.Caption = ""
  lstFiles.Clear
End Sub

Private Sub cmdSuchen_Click()
  Dim tStart As Single
  Dim tEnd As Single
  Dim tDiff As String

  Dim i As Long
  Dim strMsg As String

  lstFiles.Visible = False
  lstFiles.Clear

  m_blnCancel = False
  m_lngDirCount = 0
  m_lngFileCount = 0

  ReDim m_astrFiles(0 To 100)

  tStart = GetTickCount()

  Set m_objFSO = New Scripting.FileSystemObject
  FindFiles Dir1.Path, txtSearchString.Text
  Set m_objFSO = Nothing

  If m_lngFileCount > 0 Then
    lblMsg.Caption = "Bitte warten... " & _
          "Die Dateien werden zur ListBox hinzugefügt..."
    DoEvents
    For i = 0 To m_lngFileCount - 1
      lstFiles.AddItem m_astrFiles(i)
    Next
  End If

  tEnd = GetTickCount()
  tDiff = Format$((tEnd - tStart) / 1000, "##0.00") & "  sec."

  strMsg = m_lngFileCount & " Dateien gefunden / " & _
           m_lngDirCount & " Ordner durchsucht."

  If m_blnCancel Then
    lblMsg.Caption = _
        "Die Suche nach Datei(en) wurde abgebrochen!  " & strMsg
  Else
    lblMsg.Caption = strMsg & " (Dauer: " & tDiff & ")"
  End If

  lstFiles.Visible = True
End Sub

Private Sub cmdAbbrechen_Click()
  m_blnCancel = True
End Sub

Private Sub FindFiles(ByVal vsFolderPath As String, _
      ByVal vsSearch As String)
  Dim objFolder As Scripting.Folder
  Dim objFolderLoop As Scripting.Folder

  Dim strFileName As String
  
  If m_blnCancel = True Then GoTo byebye

  lblMsg.Caption = vsFolderPath
  DoEvents

  On Error GoTo err_Handler
  
  Set objFolder = m_objFSO.GetFolder(vsFolderPath)

  strFileName = Dir$(m_objFSO.BuildPath(objFolder.Path, vsSearch), _
                  vbNormal Or vbHidden Or vbSystem Or vbReadOnly)

  Do While Len(strFileName) > 0
    m_astrFiles(m_lngFileCount) = m_objFSO.BuildPath( _
                        objFolder.Path, strFileName)
    m_lngFileCount = m_lngFileCount + 1
    If (m_lngFileCount Mod 100) = 0 Then
      ReDim Preserve m_astrFiles(m_lngFileCount + 100)
    End If
    strFileName = Dir$()
  Loop

  m_lngDirCount = m_lngDirCount + 1

  If objFolder.SubFolders.Count > 0 Then
    For Each objFolderLoop In objFolder.SubFolders
      FindFiles objFolderLoop.Path, vsSearch
    Next objFolderLoop
  End If

byebye:
  Set objFolder = Nothing
  On Error GoTo 0
  Exit Sub

err_Handler:
  strFileName = ""
  Resume Next
End Sub