Hallo! Habe nochmal was am Code geändert. Er sucht nun nur nach xls Dateien und das Passwort wird auch genutzt.

Als Erklärung noch. Der Code geht zwar das Ganze Verzeichnis durch, geöffnet und gesucht wird aber nur in den Dateien, in denen _Planung im Dateinamen vorkommt (alter Code Zeile 88 hier wohl 89 oder 90). Es ist also nicht so, dass er jede Datei öffnet. Das ist ja die Eingrenzung, die du auch vornehmen würdest. Den Suchbegriff kannst du vorher manuell eingeben. Du musst wieder nur den Pfad bzw. den Laufwerksnamen eingeben.

Falls es nicht klappt, nochmal melden. Vllt. erkennt er ja deinen Pfad nicht - du sagtest was von Server. Dann ggf. mal so versuchen. \\servername\pfad . Wobei \\servername würde auch wieder reichen.

Viele Grüße

Dim dateien()
Option Explicit
   
Sub DateienLesen()
     
Dim DateiName As String
Dim quelle As String
Dim i As Long
Dim j As Long
Dim Dateialt As String
Dim zeilealt As Long
Dim Namekurz As String
Dim Blatt As Object
Dim gefunden As Boolean
Dim suchwert As Variant
Dim suche As Variant
 
    
  
Dateialt = ThisWorkbook.Name
zeilealt = 1
 
suchwert = InputBox("Zu suchenden Wert eingeben!", "Suchtexteingabe")
 
ReDim dateien(0)
dateien(0) = 0
       
quelle = "        " 'Pfad eintragen
If Right(quelle, 1) = "\" Then quelle = Left(quelle, Len(quelle) - 1)
Call txtsuchen(quelle)
  
If dateien(0) = 0 Then
MsgBox "Keine .txt Dateien gefunden!"
Else
'Daten auslesen
          
    For i = 1 To dateien(0)
    DateiName = dateien(i)
    Namekurz = Right(DateiName, InStr(1, StrReverse(DateiName), "\") - 1)
    gefunden = False
     
    'die Mappen aufmachen
    Workbooks.Open DateiName, Password:="ABC"
      
    For Each Blatt In Worksheets
        suche = Application.WorksheetFunction.CountIf(ActiveSheet.UsedRange, suchwert)
         
        If suche > 0 Then gefunden = True
         
    Next Blatt
         
    Workbooks(Dateialt).Activate
    Workbooks(Namekurz).Close savechanges:=False
     
    If gefunden = True Then
        ActiveSheet.Hyperlinks.Add anchor:=ActiveSheet.Cells(zeilealt, 1), Address:=DateiName, TextToDisplay:=Namekurz
        zeilealt = zeilealt + 2
    End If
 
    Next i
End If
          
End Sub
    
 
  
Function txtsuchen(quelle As String)
Dim suche
Dim ordner()
Dim i As Long
   
ReDim ordner(0)
ordner(0) = 0
ChDrive (Left(quelle, 3))
ChDir (quelle)
  
'Ordner durchschauen
suche = Dir(quelle & "\*.*", vbDirectory)
   
Do Until suche = ""
    'Normale Dateien rausfiltern
    If (GetAttr(quelle & "\" & suche) = 16) Then
        'die hier ankommen, sind Ordner, extra speichern
        ordner(0) = ordner(0) + 1
        ReDim Preserve ordner(ordner(0))
        ordner(ordner(0)) = suche
    Else
        If Right(suche, 4) = ".xls" Then    'ggf. noch an xlsx anpassen etc. aber auch die Zahl dazu
            If Len(suche) <> Len(Replace(suche, "_Planung", "")) Then
                dateien(0) = dateien(0) + 1
                ReDim Preserve dateien(dateien(0))
                dateien(dateien(0)) = quelle & "\" & suche
            End If
        End If
    End If
           
    suche = Dir()
Loop
'jetzt durch die Ordner gehen
For i = 1 To UBound(ordner)
    If Dir(ordner(i), vbNormal) = "" And Left(ordner(i), 1) <> "." Then
        Call txtsuchen(quelle & "\" & ordner(i))
        ChDir (quelle)
    End If
Next
End Function