Direktfenster oder TXT-Datei? Problem damit.

Public Sub xDirFile(xpath As String)
Dim xa As Long
Dim xDir As String
ReDim xt(0) As String
Dim xi As Long
Dim xAc As String
Dim wb As Workbook
Dim aLinks
Dim i As Integer
Dim newlink As String
xDir = Dir(xpath & "\*.*", vbNormal Or vbReadOnly Or vbHidden _
Or vbSystem Or vbVolume Or vbDirectory Or vbArchive)
xa = 0
If Len(xDir) > 0 Then
xt(0) = xDir
End If
Do While Len(xDir) > 0
xDir = Dir
If Len(xDir) > 0 And Not xDir = "." And Not xDir = ".." Then
xa& = xa& + 1
ReDim Preserve xt(xa)
xt(xa) = xDir
End If
Loop
On Error GoTo Schleife
For xi& = 0 To xa&
If Len(xt(xi)) = 0 Then
Exit For
ElseIf Not xt(xi) = "." And Not xt(xi) = ".." Then
If Len(Dir$(xpath$ & "\" & xt$(xi&), vbNormal Or vbReadOnly Or vbHidden _
Or vbSystem Or vbVolume Or vbDirectory Or vbArchive)) > 0 Then
If Not (GetAttr(xpath & "\" & xt(xi)) And vbDirectory) = vbDirectory Then
'wenn Exceldatei
If UCase(Right(xt(xi), 3)) = "XLS" Then
Set wb = Workbooks.Open(xpath & "\" & xt(xi), 0, True)
aLinks = wb.LinkSources(xlExcelLinks)
If Not IsEmpty(aLinks) Then
' Zählvariable -> kann weggelassen werden
z = z + 1
For i = 1 To UBound(aLinks)
' Ausgabe der verwendeten Links im Direktfenster
Debug.Print aLinks(i)
Next i
End If
wb.Close savechanges:=False
Set wb = Nothing
End If
Else
Call xDirFile(xpath & "\" & xt(xi))
End If
End If
End If
Schleife:
Next xi&
On Error GoTo 0
End Sub

' Aufrufprozedur zum Start
Sub test()
Application.ScreenUpdating = False
z = 0
' der hier angegebene Pfad wird mit all seinen Unterpfaden durchgegangen
xDirFile "C:\Test"
Application.ScreenUpdating = True
' Ausgabe der Zählvariable im Direktfenster
Debug.Print z
End Sub

Gruss
Andreas