Sub Dateien_eines_Ordners_Auflisten()
Dim wks As Worksheet
Dim lngZeile As Long
Dim objFileSystem As Object
Dim objVerzeichnis As Object
Dim objDateienliste As Object
Dim objDatei As Object
Set wks = ActiveWorkbook.Worksheets("Tabelle2")
wks.Range(Cells(2, 2), Cells(3000, 3)).ClearContents
Set objFileSystem = CreateObject("scripting.FileSystemObject")
Set objVerzeichnis = objFileSystem.GetFolder("Ordnerpfad")
Set objDateienliste = objVerzeichnis.Files
lngZeile = 2
For Each objDatei In objDateienliste
If Not objDatei Is Nothing And Right(LCase(objDatei.Name), 4) = ".pdf" Then
ActiveSheet.Cells(lngZeile, 2) = objDatei.Name
ActiveSheet.Hyperlinks.Add Anchor:=Tabelle2.Cells(lngZeile, 2), _
Address:="objDateienliste", _
TextToDisplay:=Tabelle2.Cells(lngZeile, 2).Value
lngZeile = lngZeile + 1
End If
Next objDatei
End Sub