[RESOLVED] [EXCEL] does not go to ErrorHandler

[Dragolin]

Sub CreateIndex()

Dim filePropertyReader As DSOleFile.PropertyReader
Dim fileProperties As DSOleFile.DocumentProperties
Dim numberOfDeletables As Integer

On Error GoTo ErrorHandler

Set filePropertyReader = New DSOleFile.PropertyReader
filePropertyReader.UseUnicodePropSets = True

numberOfDeletables = 0
    
    Application.StatusBar = "Read Directories Level 1 (Language)"
    Application.ScreenUpdating = False
    Dim fs, f, f1, sf
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    DefaultLocation = Sheets("Parameters").Cells(2, 2)
    i = 0
    ReDim Patharray(3, 0) As String
    
    '1. read all information
    '1.1. read directories level 1
    Set f = fs.GetFolder(DefaultLocation)
    Set sf = f.SubFolders
    For Each f1 In sf
        Patharray(0, i) = f1 & "\"
        Patharray(1, i) = f1.Name
        i = i + 1
        ReDim Preserve Patharray(3, UBound(Patharray, 2) + 1)
    Next
    
    '1.1. read directories level 2
    
    Application.ScreenUpdating = True
    Application.StatusBar = "Read Directories Level 2 (Channel)"
    Application.ScreenUpdating = False
    
    i = UBound(Patharray, 2)
    j = UBound(Patharray, 2)
    For teller = 0 To j - 1
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set f = fs.GetFolder(Patharray(0, teller))
        Set sf = f.SubFolders
        
        For Each f1 In sf
            Patharray(0, i) = f1 & "\"
            Patharray(1, i) = Patharray(1, teller)
            Patharray(2, i) = f1.Name
            i = i + 1
            ReDim Preserve Patharray(3, i)
        Next
    Next
    
    '1.1. read directories level 3
    
    Application.ScreenUpdating = True
    Application.StatusBar = "Read Directories Level 3 (Sub-Channel/Customer)"
    'Application.ScreenUpdating = False
    
    j = i
    For teller = 0 To j - 1
        If Patharray(2, teller) <> "" Then
            Set fs = CreateObject("Scripting.FileSystemObject")
            Set f = fs.GetFolder(Patharray(0, teller))
            Set sf = f.SubFolders
            
            For Each f1 In sf
                Patharray(0, i) = f1 & "\"
                Patharray(1, i) = Patharray(1, teller)
                Patharray(2, i) = Patharray(2, teller)
                Patharray(3, i) = f1.Name
                i = i + 1
                ReDim Preserve Patharray(3, i)
            Next
        End If
    Next
    
    ReDim Preserve Patharray(3, i - 1) As String
    Sheets("ListOfDocuments").Select
    'On Error Resume Next
    Selection.AutoFilter
    Range("A2:I5000").ClearContents
    Cells(1, 1).Select
    Selection.AutoFilter
    With ActiveSheet
        If .FilterMode Then
            .ShowAllData
        End If
    End With
    'On Error GoTo 0
    Columns("A:Z").Select
    Selection.EntireColumn.Hidden = False
    Cells(2, 1).Select
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    Application.ScreenUpdating = True
    Application.StatusBar = "Read File properties"
    Application.ScreenUpdating = False
    
    For teller = 0 To i - 1
        
        Application.ScreenUpdating = True
        Application.StatusBar = "Read File properties (" & SearchPath & ")"
        Application.ScreenUpdating = False
       
        
        SearchPath = Patharray(0, teller)
        x = Dir(SearchPath, vbNormal)
        Do Until x = ""
            If x <> "." And x <> ".." Then
                ActiveCell = "Active"
                ActiveCell.Offset(0, 1).Select
                ActiveCell = x
                ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=Patharray(0, teller) & x, TextToDisplay:=x
                ActiveCell.Offset(0, 1).Select
                ActiveCell = Patharray(1, teller) 'Language
                ActiveCell.Offset(0, 1).Select
                ActiveCell = Patharray(2, teller) 'Channel
                ActiveCell.Offset(0, 1).Select
                ActiveCell = Patharray(3, teller) 'Customer
                ActiveCell.Offset(0, 1).Select
                
                'On Error GoTo ErrorHandler
                
                Set fileProperties = filePropertyReader.GetDocumentProperties(Patharray(0, teller) & x)
                
                If FrmMain.OptSince = True Then
                    'If FileDateTime(Patharray(0, teller) & x) - Sheets("Parameters").Cells(4, 2) > 0 Then
                    If fileProperties.CustomProperties("CheckedIn") - Sheets("Parameters").Cells(4, 2) > 0 Then
                        If Right(x, 4) <> ".lnk" Then
                            ActiveCell = "New"
                        Else
                            ActiveCell = ""
                        End If
                    Else
                        ActiveCell = ""
                    End If
                Else
                    'If Now() - FileDateTime(Patharray(0, teller) & x) < Sheets("Parameters").Cells(3, 2) Then
                     If fileProperties.CustomProperties("CheckedIn") >= Sheets("Parameters").Cells(4, 2) Then
                        If Right(x, 4) <> ".lnk" Then
                            ActiveCell = "New"
                        Else
                            ActiveCell = ""
                        End If
                    Else
                        ActiveCell = ""
                    End If
                End If
                ActiveCell.Offset(0, 1).Select
                
                ActiveCell = fileProperties.Author
                
                'Set f = fs.GetFile(Patharray(0, teller) & x)
                'IsNewDocument = (f.Attributes And archive)
                ActiveCell.Offset(0, 1).Select
                'ActiveCell = FileDateTime(Patharray(0, teller) & x) 'Time
                ActiveCell = fileProperties.CustomProperties("CheckedIn") 'Time
                
                ActiveCell.Offset(0, 1).Select
                
                ActiveCell = fileProperties.CustomProperties("ValidTo").Value
                
                If ActiveCell < Date Then
                    ActiveCell.Offset(0, -8).Select
                    ActiveCell = "Delete"
                    numberOfDeletables = numberOfDeletables + 1
                    ActiveCell.Offset(0, 8).Select
                End If
                
                ActiveCell.Offset(0, 1).Select
                ActiveCell = Patharray(0, teller) & x 'Path
                ActiveCell.Offset(1, -9).Select
                
                Set fileProperties = Nothing
                
            End If
            x = Dir
            
        Loop
    Next
    Application.ScreenUpdating = True
    Application.StatusBar = "Done"
    
    If numberOfDeletables <> 0 Then
        intDummy = MsgBox("There are " & numberOfDeletables & " files ready to be deleted." & vbCrLf & _
                   "Do you want to remove them now ?", vbExclamation + vbYesNo, "Warning")
        If intDummy = vbYes Then
            Call DeleteIndex
        End If
    End If

ErrorExit:
    Exit Sub

ErrorHandler:
    Select Case Err.Number
        Case -2147220987
    'If Err.Number = -2147220987 Then
            fileProperties.CustomProperties.Add "CheckedIn", CDate(Date - 11)
            fileProperties.CustomProperties.Add "ValidTo", CDate("31/12/2099")
            fileProperties.CustomProperties.Add "IsNew", CBool(False)
            Resume
        Case 429
    'ElseIf Err.Number = 429 Then
            MsgBox Err.Number & " " & Err.Description & vbCrLf & "Please contact your administrator.", vbCritical + vbOKOnly, "Error"
            Resume ErrorExit
        Case Else
    'Else
            MsgBox Err.Number & " " & Err.Description
            Resume ErrorExit
    End Select
    'End If
    'Resume Next

Set filePropertyReader = Nothing
End Sub

The code ran before in 2003, but is now stopping at the orange line, while giving the following debug code:

Run-time error=-2147220987 (80040205), the property 'CheckedIn' does not exist in the collection

It is supposed to go to ErrorHandler when the CheckedIn does not exist, but for some reason it does not ...

Any suggestions?

[si_the_geek]

Right-click on the code window, and select "Toggle". There are various options for errors, make sure that you don't have "all errors" selected (I think "unhandled" is the one you want).

[MarkWalsh]

One thing I would recomment would be to always use variables in your 'If' statements instead of references to objects.:

If fileProperties.CustomProperties("CheckedIn") >= Sheets("Parameters").Cells(4, 2) Then

In your error code, you have a 'Resume Next' (although it's commented out). If an error occurs in the If Statement because the reference doesn't exist (which is a definite possibility with a custom property) then the resume next will continue to the next line regardless of the conditions in the If statement. Setting a variable to the object reference and using that variable would cause the error to happen before the If statement.