Thx - ist mir so gar nicht aufgefallen!

Übrigens für hartgesottene Administratoren -
der Cmd ist immer noch in Windows implementiert,
eine Dateisuche erledigt der dir-Befehl x-mal schneller als VBA Code,
und so eine Stapeldatei kannst du mit dem Windows Explorer immer in jedes
gewünschte Unterverzeichnis schieben (Netzlaufwerke nur mit LW-Buchstaben!)

und dort mit Klick starten!

Die Auswertungs-Excel-Datei lege ich praktischerweise in den temporären
Ordner des Benutzers und was dort abgeht kannst du selber besser coden als ich!

Gruß


Code Batch-Datei

@echo off
@echo Dateiname als Maske z.B. *Plan*.xls
set /p Maske=
IF /==%Maske% exit
del /F /Q %TMP%\xlsgefunden.txt
dir %Maske% /b /s | sort /r  > %TMP%\xlsgefunden.txt
start %TMP%\Hyperlinks.xlsm


Bleistift-Excel

'Muster - berücksichtigt die bisher bekannten Anforderungen
'------------------------------------------------------------------------------
'diesen Code in einer leeren Exceldatei und
'als "Hyperlinks.xlsm" im lokalen Ordner des Windows-Benutzers XXXXXX speichern
'z.B. C:\Users\XXXXXX\AppData\Local\Temp
'------------------------------------------------------------------------------
'die Sub am besten auch mit dem Workbook.Open Ereignis verknüpfen
'
Option Explicit
Sub InSpalte()
Dim TextDatei As String
Dim hf As Integer
Dim Zeilen() As String, Vergleich As String
Dim letzteZ As Long, x As Long, flag As Boolean
On Error GoTo Fehler
Application.ScreenUpdating = False
hf = FreeFile
TextDatei = ThisWorkbook.Path & "\xlsgefunden.txt"
Open TextDatei For Input As hf
Zeilen = Split(Input(LOF(hf), hf), vbNewLine)
If UBound(Zeilen) = -1 Then
   Call MsgBox("kein Treffer!", vbCritical, "Abbruch")
   Exit Sub
End If
With Range("B1")
   .CurrentRegion.Clear
   .CurrentRegion.ClearHyperlinks
   .Resize(UBound(Zeilen), 1).Value = Application.Transpose(Zeilen)
End With
'
Fehler:
Close hf
Application.ScreenUpdating = True
If Err.Number = 0 Then
   Select Case MsgBox("Nur die Dateien am Ende eines Astes?", _
   vbYesNoCancel Or vbQuestion Or vbDefaultButton1, "Einschränkungen")
      Case vbYes
         flag = NurAmPfadende()
         '
      Case vbNo
      'ggf. weitere Einschränkungen
      '
      Case vbCancel
         Exit Sub
   End Select
flag = NurinOrdnern()
If flag = True Then Call NeueLinks
End If
End Sub
Private Function NurAmPfadende() As Boolean
Dim letzteZ As Long, x As Long
Dim Vergleich As String
On Error GoTo Fehler
Application.ScreenUpdating = False
letzteZ = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
For x = letzteZ To 2 Step -1
   Vergleich = Range("B" & x).Value
   Vergleich = Left(Vergleich, InStrRev(Vergleich, "\") - 1)
   If InStr(Range("B" & x - 1).Value, Vergleich) > 0 Then Rows(x).Delete
Next x
NurAmPfadende = True
Fehler:
Application.ScreenUpdating = True
End Function
Private Function NurinOrdnern() As Boolean
Dim letzteZ As Long, x As Long
Dim Suchwert As String
On Error GoTo Fehler
Application.ScreenUpdating = False
Suchwert = InputBox("Zu durchsuchenden Ordner eingeben!", "Ordnername")
If Suchwert = "" Then
   NurinOrdnern = True
   Exit Function
End If
letzteZ = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
For x = letzteZ To 2 Step -1
   If InStr(Range("B" & x - 1).Value, Suchwert) = 0 Then Rows(x).Delete
Next x
letzteZ = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
NurinOrdnern = True
Fehler:
Application.ScreenUpdating = True
End Function
Private Sub NeueLinks()
Dim letzteZ As Long, x As Long
Dim Suchwert As String
On Error GoTo Fehler
Suchwert = InputBox("Zu suchenden Wert eingeben!", "Suchtexteingabe")
If Suchwert = "" Then Exit Sub
Application.ScreenUpdating = False
letzteZ = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
For x = 1 To letzteZ
'

' "Dateien öffnen, durchsuchen wie ......."
'
Next x
Fehler:
Application.ScreenUpdating = True
End Sub