Ok Danke.

Welcher Teil von aufrans Code wäre denn dann für "Workbooks.Open DateiName, Password:="ABC", ReadOnly:=True" einzusetzen?

Im Moment nutze ich diesen Code:

Dim dateien()
 
Option Explicit
     
Sub DateienLesen2()
       
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
 
Application.ScreenUpdating = False
    
    
Dateialt = ThisWorkbook.Name
zeilealt = 3
ActiveSheet.Columns(2).ClearContents
 
suchwert = InputBox("Bitte gebe den Namen des Schulkindes an. (Nachname reicht aus!)", "Suchtexteingabe")
   
If suchwert = "" Then
    MsgBox "Du hast keinen Wert eingegeben oder Abbrechen angeklickt. Die Suche wird beendet.", , "Abbruch Eingaben"
    End
End If
   
ReDim dateien(0)
dateien(0) = 0
         
quelle = "V:\0101\SCHULEN\0-FAHRT"
If Right(quelle, 1) = "\" Then quelle = Left(quelle, Len(quelle) - 1)
  
If Dir(quelle & "\") = "" Then
    MsgBox "Der Pfad wurde nicht gefunden!"
    End
End If
  
 
 
    Call txtsuchen2("1" & 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", ReadOnly:=True
        
    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, 2), Address:=DateiName, TextToDisplay:=Namekurz
        zeilealt = zeilealt + 1
    End If
   
    Next i
End If
            
End Sub
      
   
    
Function txtsuchen2(pfads As String)
Dim suche
Dim i As Long
Dim quelle As String
Dim oOrdner
Dim oDateien
Dim datsystem
Dim knoten
Dim datei
Dim ablage
Dim dname As String
Dim onam As String
Dim anfang
  
Set datsystem = CreateObject("Scripting.FileSystemObject")
quelle = pfads
  
anfang = Left(pfads, 1)
quelle = Right(pfads, Len(pfads) - 1)
  
ChDrive (Left(quelle & "\", 3))
ChDir (quelle)
Set knoten = datsystem.getfolder(quelle)
  
Set oDateien = knoten.Files
Set oOrdner = knoten.subFolders
  
For Each ablage In oOrdner
    onam = ablage.Name
        If Left(onam, 1) <> "." Then
            If anfang <> "x" Then
            ' tiefe ab der der filter greift
                If anfang = 2 Then
                    Call txtsuchen2("x" & ablage.Path)
                Else
                    Call txtsuchen2((anfang + 1) & ablage.Path)
                End If
            Else
                If InStr(1, onam, "16", 1) > 0 Or InStr(1, onam, "Region", 1) > 0 Or InStr(1, onam, "Rahmenvertrag", 1) > 0 Or InStr(1, onam, "Abrechnung", 1) > 0 Then
                    If InStr(1, onam, "nderung", 1) > 0 Or InStr(1, onam, "ahrpl", 1) > 0 Or InStr(1, onam, "14", 1) > 0 Or InStr(1, onam, "12-", 1) > 0 Or InStr(1, onam, "11", 1) > 0 Or InStr(1, onam, "10", 1) > 0 Or InStr(1, onam, "9", 1) > 0 Or InStr(1, onam, "08", 1) > 0 Or InStr(1, onam, "07", 1) > 0 Or InStr(1, onam, "06", 1) > 0 Or InStr(1, onam, "05", 1) > 0 Or InStr(1, onam, "04", 1) > 0 Or InStr(1, onam, "03", 1) > 0 Or InStr(1, onam, " alt", 1) > 0 Or InStr(1, onam, "inzel", 1) > 0 Or InStr(1, onam, "euorga", 1) > 0 Then
                    ' die Werete gefunden, da nichts machen
                    Else
                       Call txtsuchen2("x" & ablage.Path)
                    End If
                End If
            End If
        End If
Next ablage
  
For Each datei In oDateien
    dname = datei.Name
        If Left(dname, 1) <> "." Then
              
            If Right(dname, 4) = ".xls" Then    'ggf. noch an xlsx anpassen etc. aber auch die Zahl dazu
                If (InStr(1, dname, "Planung", 1) > 0 Or InStr(1, dname, "planung", 1) > 0 Or InStr(1, dname, "PLANUNG", 1) > 0) And InStr(1, dname, "16", 1) > 0 Then
                dateien(0) = dateien(0) + 1
                ReDim Preserve dateien(dateien(0))
                dateien(dateien(0)) = datei.Path
                End If
            End If
        End If
Next datei
  
Set datsystem = Nothing
Set knoten = Nothing
Set oDateien = Nothing
Set oOrdner = Nothing
  
Application.ScreenUpdating = True
 
  
End Function