DAO Error Handling in VB6

Good morning, Experts. I've been maintaining a legacy system for a while now that uses VB6 with an MS Access database on the back end using DAO for communication. I'm still working on getting something developed under .NET with a "real" RDBMS, but in the meantime I'm doing everything I can to keep the existing system afloat.

One of the biggest problems I've found so far is the number of DAO errors that come up when multiple users are in the database (shocking, huh?). Most of these are related to table/record locking, so I figured I might try to find a way to better handle those types of errors without causing the user to freak out.

I've now come up with the use of a function to determine whether or not the error is "serious" enough to stop execution of the application. After doing my research, I've gone through the entire list of trappable MS Jet and DAO errors. I think I have a list of "acceptable" errors for which I can simply put in a little sleep timer and let the application try the operation again (not indefinitely, of course). What I need now is bascially some confirmation that these errors are indeed "acceptable". Here's my preliminary list:

MESSAGE
[3009] You tried to lock table <table> while opening it, but the table cannot be locked because it is currently in use. Wait a moment and then try the operation again.
[3158] Could not save record; currently locked by another user.
[3186] Could not save; currently lockec by user <name> on machine <name>.
[3187] Could not read; currently lockec by user <name> on machine <name>.
[3188] Could not update; currently locked by another session on this machine.
[3197] The Microsoft Jet database engine stopped the process because you and another user are attempting to change the same data at the same time.
[3211] The database engine could not lock table <name> because it is already in use by another person or process.
[3212] Could not lock table <name>; currently in use by user <name> on machine <name>.
[3218] Could not update; currently locked.
[3254] ODBC - Cannot lock all records.
[3260] Could not update; currently locked by user <name> on machine <name>.
[3261] Table <name> is exclusively locked by user <name> on machine <name>.
[3262] Could not lock table.
[3330] Record in table <name> is locked by another user.
[3412] Cannot perform cascading update on the table because it is currently in use by another user.
[3413] Cannot perform cascading operation on table <name> because it is currently in use by user <name> on machine <name>.
[3414] Cannot perform cascading operation on table <name> because it is currently in use.
[3418] Cannot open <tablename>. Another user has the table open using a different network control file or locking style.
[3624] Could not read the record; currently locked by another user.
[3667] A different operation is preventing this operation from being executed.

I've found confirmation on some of these, but I would like to be sure I don't add more than I need and end up missing an error that may indicate a serious problem with the database, rather than just a table/record lock that hasn't been lifted yet.

BTW, here's the code for the DAO error trapping I'm using:
Public Function DAOErrorRetry(ByRef ErrorCount As Integer) As Boolean
    If ErrorCount <= 5 Then
        If Err.Number = 3008 Or Err.Number = 3009 Or Err.Number = 3158 Or Err.Number = 3186 _
                Or Err.Number = 3187 Or Err.Number = 3188 Or Err.Number = 3197 _
                Or Err.Number = 3260 Or Err.Number = 3261 Or Err.Number = 3262 _
                Or Err.Number = 3211 Or Err.Number = 3212 Or Err.Number = 3218 _
                Or Err.Number = 3254 Or Err.Number = 3330 Or Err.Number = 3412 _
                Or Err.Number = 3413 Or Err.Number = 3414 Or Err.Number = 3418 _
                Or Err.Number = 3624 Or Err.Number = 3667 Then
            Sleep 500
            ErrorCount = ErrorCount + 1
            
            Err.Clear
            DAOErrorHandler = True
        Else
            DAOErrorHandler = False
        End If
    Else
        DAOErrorHandler = False
    End If
End Function

Open in new window

And here's an example of how I might actually use this function.  (Please note this isn't "live" code - in fact I wrote it up in notepad - so I haven't actually tested it and there may be some typos, but this should provide a good idea of what I'm trying to accomplish):
'-----------------------------------------------------------------
' GLOBAL VARIABLE DECLARATION
'-----------------------------------------------------------------
Public dbEmployee As Database
Public tblEmployee As Recordset

'-----------------------------------------------------------------
'-----------------------------------------------------------------
Public Sub InitDB()
    ' ****************************************************************
    ' ** Dim the intErrorCount variable at the top of each routine  **
    ' ** and not globally to prevent a count of errors from another **
    ' ** routine from accidentally being passed into the error      **
    ' ** error handling for this one.                               **
    ' ****************************************************************
    Dim intErrorCount As Integer

    On Error GoTo InitDBError

    If Len(AppInfo.DataPath) = 0 Then Err.Raise -8000
    
    intErrorCount = 0

    ' ****************************************************************
    ' ** Open the database and the retrieve the table data for use. **
    ' ****************************************************************
    Set dbEmployee = DBEngine.OpenDatabase(AppInfo.DataPath, False, False)
    Set tblEmployee = dbEmployee.OpenRecordset("Employee", dbOpenDynaset)

    Exit Sub
InitDBError:
    ' ****************************************************************
    ' ** If the application was unable to determine the path to the **
    ' ** Access database, prompt the user for the location of the   **
    ' ** .mdb file.                                                 **
    ' ****************************************************************
    If Err.Number = -8000 Then
        With frmMain.dlgMain
            .InitDir = AppInfo.ApplicationPath
            .Filter = "*.mdb"
            .ShowOpen

            If Len(.FileName) = 0 Then
                MsgBox "You did not select a database for the application." & vbcrlf & vbcrlf & _
                       "Application terminating.", vbOKOnly + vbCritical, "NO DATABASE SELECTED"
                End
            Else
                AppInfo.DataPath = .FileName
            End If
        End With
        
        Resume Next
    ' ****************************************************************
    ' ** If any other error occurred while trying to connect to or  **
    ' ** retrieve data from the Access database, display an error   **
    ' ** and terminate execution of the application.                **
    ' ****************************************************************
    Else
        If Not DAOErrorRetry(intErrorCount) Then
            MsgBox "An error occurred while connecting to the database." & vbcrlf & vbcrlf & _
                   "Error Number: " & Err.Number & vbcrlf & _
                   "Error Source: " & Err.Source & vbcrlf & _
                   "Error Description " & Err.Description & vbcrlf & vbcrlf & _
                   "Application terminating.", vbOKOnly + vbCritical, "DATABASE CONNECTION FAILED"
            Err.Clear
            End
        Else
            intErrorCount = 0
            Resume
        End If
    End If
End Sub

'-----------------------------------------------------------------
'-----------------------------------------------------------------
Private Sub SaveRecord()
    Dim intErrorCount As Integer

    On Error GoTo SaveRecordError
    
    intErrorCount = 0
    
    With tblEmployee
        .FindFirst "EmpID = '" & frmMain.txtMain(0).Text & "'"
        
        If Not tblEmployee.NoMatch Then
            .Edit
        Else
            .AddNew
        End If
        
        !FirstName = Trim(frmMain.txtMain(1).Text)
        !LastName = Trim(frmMain.txtMain(2).Text)
        !Address1 = Trim(frmMain.txtMain(2).Text)
        !Address2 = Trim(frmMain.txtMain(2).Text)
        !City = Trim(frmMain.txtMain(2).Text)
        !State = Trim(frmMain.txtMain(2).Text)
        !ZIPCode = Trim(frmMain.txtMain(2).Text)
        .Update
    End With
    
    Exit Sub
SaveRecordError:
    If Not DAOErrorRetry(intErrorCount) Then
        MsgBox "An error occurred while attempting to update the employee record." & vbcrlf & vbcrlf & _
               "Error Number: " & Err.Number & vbcrlf & _
               "Error Source: " & Err.Source & vbcrlf & _
               "Error Description " & Err.Description & vbcrlf & vbcrlf & _
               "Your changes to this employee were not saved." & vbcrlf & vbcrlf & _
               "Please contact the IT HelpDesk for assistance.", vbOKOnly + vbCritical, "UPDATE RECORD FAILED"
        Err.Clear
        End
    Else
        intErrorCount = 0
        Resume
    End If
End Sub

'-----------------------------------------------------------------
'-----------------------------------------------------------------
Private Sub DeleteRecord()
    Dim intErrorCount As Integer

    On Error GoTo DeleteRecordError
    
    intErrorCount = 0
    
    With tblEmployee
        .FindFirst "EmpID = '" & frmMain.txtMain(0).Text & "'"
        
        If Not tblEmployee.NoMatch Then
            .Delete
        Else
            MsgBox "The record for employee number " & frmMain.txtMain(0).Text & " could not be found in the database." & vbcrlf & _
                   "The record may have already been deleted."  & vbcrlf & vbcrlf & _
                   "If you continue to see this message, please contact the IT HelpDesk for assistance.", _
                   vbOKOnly + vbInformation, "NO RECORD FOUND."
        End If
    End With
    
    Exit Sub
DeleteRecordError:
    If Not DAOErrorRetry(intErrorCount) Then
        MsgBox "An error occurred while attempting to delete the employee record from the database." & vbcrlf & vbcrlf & _
               "Error Number: " & Err.Number & vbcrlf & _
               "Error Source: " & Err.Source & vbcrlf & _
               "Error Description " & Err.Description & vbcrlf & vbcrlf & _
               "Please contact the IT HelpDesk for assistance.", vbOKOnly + vbCritical, "DELETE RECORD FAILED"
        Err.Clear
        End
    Else
        intErrorCount = 0
        Resume
    End If
End Sub

Open in new window

So, the basic question really is simply this: Is my list of "acceptable" errors okay, or might it be a little TOO thorough or not thorough enough.  Thanks so much for your input and help.
LVL 2
G_Hosa_PhatAsked:
Who is Participating?
 
Jim Dettman (Microsoft MVP/ EE MVE)Connect With a Mentor President / OwnerCommented:
<<So, the basic question really is simply this: Is my list of "acceptable" errors okay, or might it be a little TOO thorough or not thorough enough.  Thanks so much for your input and help. >>

  There's really no answer to your question.  Only you can determine what is acceptable or not in a given situation.  For example:

[3197] The Microsoft Jet database engine stopped the process because you and another user are attempting to change the same data at the same time.

 Can mean a problem with the app itself and there is never a legit reason you should see this in the course of normal operations.

  As far was your DAOErrorRetry(), you probably won't get far with that because your backing off the same time frame for each user.  If both are conflicting now, both will still be conflicting at the end of Sleep 500.
 
  What you want is something along the lines of this:

        'Table locked by another user
220     If Err = CNT_ERR_RESERVED Or Err = CNT_ERR_COULDNT_UPDATE Or Err = CNT_ERR_OTHER Then
230       intLockCount = intLockCount + 1
240       If intLockCount > 5 Then
250         GetRecordKeys = Null
260         Resume GetRecordKeysExit
270       Else
280         DoEvents
290         DBEngine.Idle DB_FREELOCKS
300         lngWait = intLockCount ^ 2 * Int(Rnd * 20 + 5)
310         For lngX = 1 To lngWait
320           DoEvents
330         Next lngX
340         Resume
350       End If
360     Else
370       MsgBox "Unexpected error"
380       GetRecordKeys = Null
390       Resume GetRecordKeysExit
400     End If


   which varies the timeout.  Also, you want to be free up locks your holding.  Otherwise you'll never avoid a dead lock situation.

   Also you don't mention the JET version, but locking has continually improved from release to release.  You should be using JET 4.0.

  Finially, when you get to the "real" RDBMS, make sure you keep your error handling because concurrency issues will arise with any RDBMS product.

Jim.
0
 
G_Hosa_PhatAuthor Commented:
@JDettman - Thanks for the insight and the example code.  I'll take a look at that implementation as a replacement as the timeout piece was one thing I was a little concerned with, even as I was looking at it.

I'll definitely keep some form of these tests in my new system, but I'm planning a complete rewrite of the whole application in .NET, and I'm still working on finalizing the database structure before I move forward with that.

BTW, I am using Jet 4.0 (should've mentioned that in the original post, but didn't think of it).
0
 
Jim Dettman (Microsoft MVP/ EE MVE)President / OwnerCommented:
<<BTW, I am using Jet 4.0 (should've mentioned that in the original post, but didn't think of it). >>

 If you continue to have a large number of concurrency issues, you may want to consider record level locking.

  However with record level locking being added after DAO was cut off, you need to use an ADO connection first to the DB to enable record level locking under DAO.  That's covered here:

PRB: Jet 4.0 Row-Level Locking Is Not Available with DAO 3.60
http://support.microsoft.com/kb/306435

  Even with that, there are situations where it will still page lock; index operations and updates to long value pages (OLE and Memo fields).

  Microsoft really did a poor job of adding record level locking.


  Another approach is to pad records to the point where they occupy more then half a data page.  Since JET will never split a record across pages, this forces one record per page and hence "record level Locking".

  There are still issues with that (memo fields), but with this you can enable "record level" locking on a table by table basis.  

   Wastes disk space but it is a viable technique in a pinch, especially when you only have a table or two that gives you an issue with page level locking.

  Best of luck with the forth coming conversion.

Jim.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.