Option Explicit

Private Const mc_Title As String = _
                 "Dateisuche mit dem FileSearch-Objekt"

Private Sub UserForm_Initialize()
  Me.Caption = mc_Title
  Me.txtLookIn.Text = CurDir

  Me.lblFilesCnt.Caption = "Datei(en) gefunden"
  Me.lblFileName.Caption = ""

  Me.chkSubFolders.Value = False

  With Me.cboFileFilter
    .AddItem ".doc"
    .AddItem ".dot"
    .AddItem ".txt"
    .AddItem "*.*"

    .ListIndex = 0
  End With

  With Me.lstFiles
    .Clear
    .BoundColumn = 0
    .ColumnCount = 3
    .ColumnWidths = "0"
  End With
End Sub

Private Sub cmdSearch_Click()
  Dim strLookIn As String

  Me.lblFileName.Caption = ""
  Me.lstFiles.Clear

  strLookIn = Trim$(Me.txtLookIn.Text)
  If Len(strLookIn) = 0 Then
    MsgBox "Bitte geben Sie das Verzeichnis ein, " & _
           "in dem nach Dateien gesucht werden soll.", _
           vbOKOnly + vbInformation, mc_Title

    Me.txtLookIn.SetFocus
    Exit Sub
  End If

  If Len(Dir(strLookIn, vbDirectory)) = 0 Then
    MsgBox "Das angegebene Verzeichnis existiert nicht!", _
           vbOKOnly + vbInformation, mc_Title
    Me.txtLookIn.SetFocus
    Exit Sub
  End If

  Dim avarFiles As Variant

  If Me.cboFileFilter.Text = "*.*" Then
    avarFiles = _
          GetFileSearch(strLookIn, , Me.chkSubFolders.Value)
  Else
    avarFiles = GetFileSearch(strLookIn, _
               Me.cboFileFilter.Text, Me.chkSubFolders.Value)
  End If

  If IsArray(avarFiles) Then
    Me.lblFilesCnt.Caption = _
           CStr(UBound(avarFiles, 2)) & " Datei(en) gefunden"
    Me.lstFiles.Column() = avarFiles
    Me.lstFiles.ListIndex = 0
  Else
    Me.lblFilesCnt.Caption = "Keine Datei(en) gefunden"
  End If
End Sub

Private Sub lstFiles_Click()
  With Me.lstFiles
    Me.lblFileName.Caption = .List(.ListIndex, .BoundColumn)
  End With
End Sub

Private Function GetFileSearch(ByVal sLookIn As String, _
      Optional varFileFilter As Variant, Optional _
      fSearchSubfolders As Boolean = False) As Variant

  Dim astrFiles() As String
  Dim nFilesCnt   As Long
  Dim n           As Long
  Dim strFileName As String

  On Error Resume Next

  With Application.FileSearch
    .NewSearch
    .LookIn = sLookIn
    .SearchSubFolders = fSearchSubfolders

    If Not IsMissing(varFileFilter) Then
      .FileName = varFileFilter
    Else
      .FileType = msoFileTypeAllFiles
    End If

    If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending, _
            AlwaysAccurate:=True) > 0 Then

      nFilesCnt = .FoundFiles.Count
      ReDim astrFiles(1 To 3, 1 To nFilesCnt)

      For n = 1 To nFilesCnt
        strFileName = .FoundFiles(n)
        astrFiles(1, n) = strFileName
        astrFiles(3, n) = FileDateTime(strFileName)

        Do
          strFileName = Right$(strFileName, _
                (Len(strFileName) - InStr(strFileName, "\")))
        Loop While InStr(strFileName, "\") > 0
        astrFiles(2, n) = strFileName
      Next

      GetFileSearch = astrFiles
    End If
  End With

  On Error GoTo 0
End Function