alexander01
Goto Top

Excel VB-Script fehlerhaft

Hallo,
ich habe ein Excel-VB Script, welches aus mehreren (ca. 80) Excel-Arbeitsmappen jeweils die letzte verwendete Zeile der ersten Spalte (ein Datum) ausliest.
Leider ist der ausgelesene Wert bei einigen Dateien leer. Ich weiß nicht warum. Möglicherweise kann das Script die Dateien nicht öffnen? Oder irgendeine interne Bezeichnung ist in einigen Arbeitsmappen anders (die Arbeitsmappen beruhen auf verschiedenen Vorlagen, die meines Wissens nach jedoch in dieser Frage gleich sind).
Kann man irgendein Log einbauen, um den Fehler zu finden?
In einem Ersten Schritt werden alle gefundenen Dateien eines Verzeichnisses aufgelistet (Spalte1 = ColName),
hier erscheinen auch alle Dateien ordnungsgemäß.
Im zweiten Schritt (Sub CommandButton3) soll aus allen aufgelisteten Arbeitsmappen der Wert einer bestimmten Zelle (die letzte in Spalte1) ausgelesen werden.
lasse ich mir die Variablen "XlsPath" und "objCells.Value" in einem Feld anzeigen, erscheinen die nur bei einigen Dateien (ca. 3/4), sind hier natürlich korrekt.
Bei manchen sind diese Angaben leer und mglweise infolgedessen auch der Inhalt der auszulesenden Zelle.

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
                        .Columns(ColLRow).Value = intRowEnd
    
                        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

Hat jemand eine Idee? Könnte es mit unterschiedlichen Excel-Versionen zusammenhängen? Sind manche Dateien (alle liegen auf dem Server) mit anderen Zugriffsrechten ausgestattet? Kann man eine Log-Datei erstellen?
Danke für alle Hinweise!
Gruß
Alexander

Content-Key: 5556780435

Url: https://administrator.de/contentid/5556780435

Printed on: May 20, 2024 at 15:05 o'clock

Member: alexander01
alexander01 Jan 22, 2023 at 18:32:14 (UTC)
Goto Top
habe den Fehler gefunden.
auf einigen Arbeitsmappen war für die Felder CellsCheckBox und CellsLastDate keine Funktion definiert, sie waren also leer.
Funktion eingetragen und schon läufts.
Grüße
Alexander