Erbitte Hilfe bei VBA-Script in Excel-Datei

Option Explicit
Option Compare Text

Private Const XlsPath = "K:\Ausweise\"           'Dateipfad: Xls-Dateien  
Private Const LogFile = "K:\Ausweise\Err.Log"    'Dateipfad: Log-Datei  

Private Const CellsCheckBox = "Z10"                     'Zelladresse: CheckBox-Status  
Private Const CellsLastDate = "Z11"                     'Zelladresse: Letztes Datum  

Private Const RowStart = 6

Private Const ColName = 1
Private Const ColSize = 2
Private Const ColDate = 3
Private Const ColAttr = 4
Private Const ColOpenDate = 5
Private Const ColOpenDays = 6
Private Const ColCheckBox = 7

Private Const MaxDays = 40

Private Sub CommandButton2_Click()
    Dim objFile As Object, intRowNext As Long, valCheckBox As Variant
    
    With Cells(RowStart, ColName).Resize(UsedRange.Rows.Count, ColOpenDays)
        .ClearContents
        .Interior.ColorIndex = xlNone
    End With
    
    intRowNext = RowStart
    
    For Each objFile In CreateObject("Scripting.FileSystemObject").GetFolder(XlsPath).Files  
        If objFile.Name Like "*.xls" Then  
            With objFile
                Cells(intRowNext, ColName).Value = .Name
                Cells(intRowNext, ColSize).Value = .Size / 1024
                Cells(intRowNext, ColDate).Value = .DateCreated
                Cells(intRowNext, ColAttr).Value = GetFileAttributes(.Attributes)
            End With
            intRowNext = intRowNext + 1
        End If
    Next
End Sub

Private Sub CommandButton3_Click()
    Dim objCells As Range, strTarget As String, valCheckBox As Variant
    Dim dblDate As Date, intRowEnd As Long, intDays As Long
    
    If Cells(RowStart, ColName).text <> "" Then  
        'Letzte Zeile ermitteln  
        intRowEnd = Cells(Rows.Count, ColName).End(xlUp).Row
        
        'Alle farbliche Markierungen löschen  
        Range(Cells(RowStart, ColName), Cells(intRowEnd, ColOpenDays)).Interior.ColorIndex = xlNone
        
        'Alle Inhalte in den Spalten E:G löschen  
        Range(Cells(RowStart, ColOpenDate), Cells(intRowEnd, ColCheckBox)).ClearContents
        
        'Alle Dateien durchlaufen und auswerten  
        For Each objCells In Range(Cells(RowStart, ColName), Cells(intRowEnd, ColName))
            'Test ob Datei existiert  
            If Dir(XlsPath & objCells.Value) <> "" Then  
                strTarget = "'" & XlsPath & "[" & objCells.Value & "]Datenblatt'!"  
                
                valCheckBox = ExecuteExcel4Macro(strTarget & Range(CellsCheckBox).Address(, , xlR1C1))
                
                'Test CheckBox auf gültigen Wert True/False  
                If valCheckBox = True Then
                    dblDate = ExecuteExcel4Macro(strTarget & Range(CellsLastDate).Address(, , xlR1C1))
                    intDays = Date - dblDate

                    With Rows(objCells.Row)
                        .Columns(ColOpenDate).Value = dblDate
                        .Columns(ColOpenDays).Value = intDays
                        .Columns(ColCheckBox).Value = valCheckBox
    
                        If intDays > MaxDays Then
                            .Columns(ColName).Interior.ColorIndex = 3
                            .Columns(ColOpenDays).Interior.ColorIndex = 3
                        End If
                    End With
                ElseIf valCheckBox <> False Then
                    Cells(objCells.Row, ColName).Resize(1, ColOpenDays).Interior.ColorIndex = 3
                End If
            Else
                Cells(objCells.Row, ColName).Resize(1, ColOpenDays).Interior.ColorIndex = 3
            End If
        Next
        
        MsgBox "Fertig!", vbInformation  
    End If
End Sub

Private Function GetFileAttributes(intAttributes As Long) As String
    Dim arrAttr As Variant, i As Integer
    
    arrAttr = Array(vbReadOnly, "R", vbHidden, "H", vbSystem, "S", vbDirectory, "D", vbArchive, "A")  
    
    GetFileAttributes = "-----"  
    
    For i = 0 To UBound(arrAttr) Step 2
        If arrAttr(i) And intAttributes Then
            Mid(GetFileAttributes, i / 2 + 1, 1) = arrAttr(i + 1)
        End If
    Next
End Function
Private Sub CommandButton4_Click()
' Programm verlassen, auf 1. Worksheet alles löschen  
Dim lz3, lz4, m, n As Integer
lz3 = Worksheets("Check").Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row  
For m = 6 To lz3
For n = 1 To 7
Worksheets("Check").Cells(m, n) = ""  
Worksheets("Check").Cells(m, n).Interior.ColorIndex = 0  
Next n
Next m

Worksheets("Prüf-Protokoll").Unprotect Password:="xyz"  
lz4 = Worksheets("Prüf-Protokoll").Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row  
Worksheets("Prüf-Protokoll").Cells(lz4 + 1, 1).Value = Date  
Worksheets("Prüf-Protokoll").Cells(lz4 + 1, 2).Value = Time  
Worksheets("Prüf-Protokoll").Protect Password:="xyz"  

ThisWorkbook.Close SaveChanges:=True
With Application
.DisplayAlerts = False
.Quit
End With
End Sub