Dateinamen aus lesen

Sub auslesen()
Dim wbMappe As Excel.Workbook
Dim strMappe As String
Dim strPfad As String
Dim loDateien As Long
Dim loZeile As Long
Dim boTabelle As Boolean
Dim inTabellen As Integer
loZeile = 4
strPfad = Ordner_Auswahl
With Application.FileSearch
.NewSearch
.LookIn = strPfad
.SearchSubFolders = False
.Filename = "*.*"
If .Execute() > 0 Then
For loDateien = 1 To .FoundFiles.Count
strMappe = Mid(.FoundFiles(loDateien), Len(strPfad) + 2)
Set wbMappe = GetObject(strPfad & "\" & strMappe)
With wbMappe
For inTabellen = 1 To .Worksheets.Count
If .Worksheets(inTabellen).Name = "Verdichtung" Then
boTabelle = True
Exit For
End If
Next inTabellen
If boTabelle = True Then
.Worksheets(inTabellen).Range("A4:BZ4").Copy
ThisWorkbook.Worksheets("Tabelle1").Cells(loZeile, 2).PasteSpecial Paste:=xlValues
boTabelle = False
End If
.Close
End With
loZeile = loZeile + 1
Next loDateien
End If
End With
End Sub

Function Ordner_Auswahl()
Const WINDOW_HANDLE = 0
Const FOLDERS_ONLY As Long = 1
Const DEFPATH As Variant = ""       ' z.B. Vorgabepfad "D:\" angeben
Dim Wscript As Application
Dim objShell As Object
Dim objFolder As Object
Dim objFolderItem As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Wählen Sie einen Ordner aus: ", _
FOLDERS_ONLY, DEFPATH)
'Set objFolder = objShell.BrowseForFolder(0&, "Ordner wählen oder anlegen...", FOLDERS_ONLY, _
DEFPATH)
If objFolder Is Nothing Then Exit Function
Set objFolderItem = objFolder.Self
Ordner_Auswahl = objFolderItem.Path
End Function

=TEIL(ZELLE("Dateiname";A1);FINDEN("[";ZELLE("Dateiname";A1))+1;FINDEN("]";ZELLE("Dateiname";A1)) -FINDEN("[";ZELLE("Dateiname";A1))-1)