Hallo Burli,

das Script ermittelt alle Dateitypen aus dem angegebenen Ordner und allen Unterordnern. Beim Reinkopieren Deines Verarbeitungsparts hatte ich leider die Zählung der gefundenen Dateien rausgekickt, da dass dort immer in der MsgBox "Nichts gefunden" angezeigt wirde. Das ist mit u.a. Script behoben.

Ich habe jetzt für das Öffnen via OpenWorkbook nur die Exceldateien zugelassen...

Die Bearbeitung der Dateien habe ich nicht angepasst, das müsstest Du selbst weiterbetrieben. Da werden ja auch zwei Sub's aufgerufen, die ich nicht habe und kenne....

Über Debug.print kannst Du Dir jetzt im Direktbereich anschauen, welche Dateien gefunden wurden.

Option Explicit

Const sPath As String = "C:\Users\volti\Desktop\"        'Hier Hauptpfad anpassen

Sub CheckFileStart()
'Durchforsten von gefilterten Dateien aus Ordner und Unterordner
 Dim iAnz As Long, sArr() As String, MsgTxt As String
 
 CheckFile iAnz, sArr, CreateObject("scripting.filesystemobject").GetFolder(sPath)
 If iAnz = 0 Then
    MsgTxt = "Es wurde keine entsprechende Datei gefunden!"
 Else
    MsgTxt = "Es wurde(n) " & iAnz & " Datei(en) gefunden und bearbeitet!"
 End If
 MsgBox MsgTxt, vbInformation, "Dateibearbeitung"
End Sub

Sub CheckFile(iAnz As Long, sArr, oPath As Object)
 Dim oFile As Object, oDir As Object, WKb As Workbook
 
 On Error Resume Next
 
 For Each oFile In oPath.Files              'Ordner durchsuchen
  If Err = 0 Then
   
    With oFile

 Debug.Print .Path                          'Später wieder rausnehmen
      If .Path Like "*.xls*" Then
        Set WKb = Workbooks.Open(Filename:=.Path)
        With .Sheets(1)
            Call Protokollkorrekturen        'getestet und funktioniert
        End With
        Call WP_LA_speichern 'Speicherort und Name abhängig von Zelleninhalt, getestet und Funktioniert
        WKb.Close
      End If
    End With
    
    iAnz = iAnz + 1
  End If
 Next
 
 For Each oDir In oPath.Subfolders          'Unterordner durchsuchen
     CheckFile iAnz, sArr, oDir
 Next

End Sub

viele Grüße

Karl-Heinz