Mit nachfolgendem Skript bekomme ich nur den jeweils aktuellen Ordner.
'StandardModule: modMain
Sub DateiBehandlung()
Dim arrFiles As Variant
Dim intCounter As Integer
Application.ScreenUpdating = False
arrFiles = FileArray("c:\excel\support", "*.xls")
For intCounter = 1 To UBound(arrFiles)
With ThisWorkbook.Worksheets(1)
.Cells(intCounter, 1) = arrFiles(intCounter)
.Hyperlinks.Add Anchor:=.Cells(intCounter, 1), _
Address:="c:\excel\support\" & .Cells(intCounter, 1).Value
End With
Next intCounter
Columns(1).AutoFit
End Sub
Function FileArray(strPath As String, strPattern As String)
Dim arrDateien()
Dim intCounter As Integer
Dim strDatei As String
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strDatei = Dir(strPath & strPattern)
Do While strDatei <> ""
intCounter = intCounter + 1
ReDim Preserve arrDateien(1 To intCounter)
arrDateien(intCounter) = strDatei
strDatei = Dir()
Loop
FileArray = arrDateien
End Function
'ClassModule: Tabelle1
Private Sub CommandButton1_Click()
Call DateiBehandlung
End Sub