Public Function GetXLFiles(ByRef astrXLFiles() As String, _
      ByVal strLookIn As String, Optional fSearchSubfolders _
      As Boolean = False) As Boolean

  Dim nFilesCnt   As Long
  Dim nFile       As Long
  Dim nCounter    As Long
  Dim strFileName As String

  On Error Resume Next
  With Application.FileSearch
    .NewSearch
    .LookIn = strLookIn
    .SearchSubFolders = fSearchSubfolders
    .FileName = ".xls"
    .FileType = msoFileTypeExcelWorkbooks

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

      nFilesCnt = .FoundFiles.Count
      ReDim astrXLFiles(0 To nFilesCnt - 1)

      nCounter = -1
      For nFile = 1 To nFilesCnt
        strFileName = .FoundFiles(nFile)
        If Len(Dir$(strFileName)) > 0 Then
          nCounter = nCounter + 1
          astrXLFiles(nCounter) = strFileName
        End If
      Next

      If nCounter > -1 Then
        ReDim Preserve astrXLFiles(0 To nCounter)
        GetXLFiles = True
      End If
    End If
  End With
  On Error GoTo 0
End Function

Public Sub Demo()
  Dim strPath       As String
  Dim astrXLFiles() As String
  Dim nFile         As Long

  strPath = ThisWorkbook.Path

  If Len(Dir$(strPath, vbDirectory)) > 0 Then
    If GetXLFiles(astrXLFiles(), strPath, True) Then

      For nFile = 0 To UBound(astrXLFiles)
        Debug.Print astrXLFiles(nFile)
      Next

      Erase astrXLFiles
    Else
      MsgBox "Keine Excel-Arbeitsmappen im Verzeichnis " & _
            vbCrLf & strPath & vbCrLf & "gefunden!", _
            vbInformation, "VB-fun-Demo"
    End If
  Else
    MsgBox "Das Verzeichnis " & vbCrLf & strPath & vbCrLf & _
          "existiert nicht!", vbInformation, "VB-fun-Demo"
  End If
End Sub