Public Function GetAllTableFromPath(ByVal sPath As String) As Variant
  On Error Resume Next
 
  Dim sFile As String, WB As Workbook, WS As Worksheet
  Dim sTables As String, sTable As String
 
  sTables = ""
 
  ' unterbindet die Bildschirmausgabe/Aktualisierung von Excel
  Application.ScreenUpdating = False
 
  ' ggf. Backslash ans Ende anfügen
  If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
 
  ' Dateien suchen
  sFile = Dir(sPath & "*.xls", vbArchive + vbReadOnly)
 
  ' alle Dateien nacheinander ermitteln
  Do Until (sFile = "") Or (Error <> "")
 
    Set WB = Nothing
    Set WB = Workbooks.Open(Filename:=sPath & sFile, ReadOnly:=True)
 
    ' wenns keine Probleme beim Öffnen gab --> Tabellen ermitteln
    If Not WB Is Nothing Then
      For Each WS In WB.Worksheets
        sTable = WS.Name
        If sTables <> "" Then sTables = sTables & vbTab
        sTables = sTables & sPath & sFile & "!" & sTable
      Next WS
      Set WS = Nothing
 
      ' Datei ohne Speichern schließen
      WB.Close False
    End If
 
    ' Fehler beim Öffnen von Dateien können ignoriert werden
    Err.Clear
 
    ' nächsten passenden Dateinamen ermitteln
    ' !!ohne Parameterangabe!! sonst ermittelt "Dir" denselben Dateinamen erneut
    sFile = Dir
  Loop
 
  ' !! aktiviert die Bildschirmausgabe/Aktualisierung von Excel !! nicht 
  ' vergessen !!
  Application.ScreenUpdating = True
 
  GetAllTableFromPath = Split(sTables, vbTab)
End Function
 
Sub Test()
  Dim vTable As Variant, x As Long
 
  ' liefert alle Tabellennamen von "A:\" im (jedoch nicht von Unterordnern)
  ' Format: Dateipfad+Dateiname!Tabellenname
  vTable = GetAllTableFromPath("A:\")
 
  ' wenn die Obergrenze kleiner die Untergrenze ist, gibts keine Daten im Array
  If UBound(vTable) < LBound(vTable) Then Exit Sub
 
  For x = LBound(vTable) To UBound(vTable)
    MsgBox vTable(x)
  Next x
 
End Sub

Viel Spass,
R@lf