Resume zonder error foutmelding met errorlogging bij netwerkfout

[JohanRVT]

Beste,

probleem met netwerkcrash waarbij dat de database in een soort oneindige loop terecht komt met dus een "resume without error" melding nadat de verbinding met de server wegviel (telenet is hier maar zwakjes de laatste tijd). Probleem is dat je dan enkel door een CTRL+Alt+Delete de DB kunt stoppen en aangezien onze serververbinding na wegvallen van het signaal automatisch alle bestaande programma's opnieuw opent ben je soms wel een tijdje bezig.
Is er een mogelijkheid om anders uit die lus te geraken?

Ik gebruik nu al enige tijd dus die functie waarbij in de errorafhandeling van een procedure de fout wordt weggeschreven naar een tabel "tLogError" met een aantal parameters.

De functie is de volgende:

Function LogError(ByVal lngErrNumber As Long, ByVal strErrDescription As String, _
    strCallingProc As String, Optional vParameters, Optional bShowUser As Boolean = True) As Boolean
On Error GoTo Err_LogError
    ' Doel: algemene fout of "error" meldingen opvangen
    ' Foutmeldingen worden opgeslagen in "tLogError".
    ' Argumenten: lngErrNumber - value of Err.Number
    ' strErrDescription - value of Err.Description
    ' strCallingProc - naam van de sub|functie die de fout hebben veroorzaakt
    ' vParameters - optional string: List of parameters to record.
    ' bShowUser - optionele boolean: Indien False, geen foutmelding aan de gebruiker getoond

    Dim strMsg As String      ' String for de messagebox
    Dim rst As DAO.Recordset  ' De tLogError tabel

    Select Case lngErrNumber
    Case 0
        Debug.Print strCallingProc & " called error 0."
    Case 2501                ' Cancelled
        'Do nothing.
    Case 3314, 2101, 2115    ' Can't save.
        If bShowUser Then
            strMsg = "Deze record kan nu niet opgeslagen worden." & vbCrLf & _
                "Vervolledig op ander manier of druk <Esc> om ongedaan te maken."
            MsgBox strMsg, vbExclamation, strCallingProc
        End If
    Case Else
        If bShowUser Then
            strMsg = "Error " & lngErrNumber & ": " & strErrDescription
            MsgBox strMsg, vbExclamation, strCallingProc
        End If
        Set rst = CurrentDb.OpenRecordset("tLogError", , dbAppendOnly)
        rst.AddNew
            rst![ErrNumber] = lngErrNumber
            rst![ErrDescription] = Left$(strErrDescription, 255)
            rst![ErrDate] = Now()
            rst![CallingProc] = strCallingProc
            rst![UserName] = CurrentUser()
            rst![ShowUser] = bShowUser
            If Not IsMissing(vParameters) Then
                rst![Parameters] = Left(vParameters, 255)
            End If
        rst.Update
        rst.Close
        LogError = True
    End Select

Exit_LogError:
    Set rst = Nothing
    Exit Function

Err_LogError:
    strMsg = "Een onverwachte gebeurtenis heeft zich voorgedaan in dit programma." & vbCrLf & _
        "Gelieve de volgende dingen te wilen noteren voor debugging: " & vbCrLf & vbCrLf & _
        "Gebruikte procedure: " & strCallingProc & vbCrLf & _
        "Fout nummer: " & lngErrNumber & vbCrLf & strErrDescription & vbCrLf & vbCrLf & _
        "De record kan niet opgeslagen worden door: " & Err.Number & vbCrLf & Err.Description
    MsgBox strMsg, vbCritical, "LogError()"
    Resume Exit_LogError
End Function

Een Voorbeeld van gebruik van deze errorcode is algemeen bij het sluiten van ieder formulier of rapport waarbij als er niets anders meer open is het hoofdschakelbord wordt geopend:

Private Sub Form_Close()
On Error GoTo Err_Form_Close
     Call Keep1Open(Me)
Exit_Form_Close:
     Exit Sub
Err_Form_Close:
     Select Case Err.Number
            Case 9999
                Resume Next
            Case 999
                Resume Exit_Form_Close
            Case Else
            Call LogError(Err.Number, Err.Description, "Form_Close()")
                Resume Exit_Form_Close
     End Select
End Sub

Zit er iets mis in de code? De bediendes krijgen die fout meestal op momenten dat de server crasht zeggen ze.

 

[JohanRVT]

heb er de Case 20 bijgezet en komt nu niet meer voor

Private Sub Form_Close()
On Error GoTo Err_Form_Close
     Call Keep1Open(Me)
Exit_Form_Close:
     Exit Sub
Err_Form_Close:
     Select Case Err.Number
            Case 20 'Resume zonder Error
                	Resume Next
            Case 9999
                Resume Next
            Case 999
                Resume Exit_Form_Close
            Case Else
            Call LogError(Err.Number, Err.Description, "Form_Close()")
                Resume Exit_Form_Close
     End Select
End Sub