[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

DAO Error Handling in VB6

Posted on 2011-10-17
3
Medium Priority
?
1,047 Views
Last Modified: 2012-05-12
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.
0
Comment
Question by:G_Hosa_Phat
  • 2
3 Comments
 
LVL 58

Accepted Solution

by:
Jim Dettman (Microsoft MVP/ EE MVE) earned 1000 total points
ID: 36980049
<<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
 
LVL 2

Author Closing Comment

by:G_Hosa_Phat
ID: 36980367
@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
 
LVL 58
ID: 36980740
<<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

Featured Post

[Webinar] Cloud and Mobile-First Strategy

Maybe you’ve fully adopted the cloud since the beginning. Or maybe you started with on-prem resources but are pursuing a “cloud and mobile first” strategy. Getting to that end state has its challenges. Discover how to build out a 100% cloud and mobile IT strategy in this webinar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
In a use case, a user needs to close an opened report by simply pressing the Escape (Esc) key. This can be done by adding macro code in Report_KeyPress or Report_KeyDown event.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…
Suggested Courses

830 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question