Append Query Fails When 2 Users Run At Same Time

[sambo]

Problem..
I run an append query behind an OnClick Event. Works fine with one user. The problem arises when two users click the button at the exact same time. This creates a primary key infraction because the db tries to write to the table at the same time from both machines. After this string of events the database is corrupted and I have to repair it. BAAADDD!!!

So..
I added a little patch. I created a table (tblTimer) that simply stores the user name of most recent entrant into the form containing the button. Now when the person clicks the button I implement the following code..

If DLookup("[User]", "tblTimer", "[Func] = 'Add Data'") <> Me.User Then
  MsgBox "WARNING!!" & vbCrLf & _
    "No Entries Made" & vbCrLf & _
    "You Clicked at the Same Time as Another User Please Try Again"
   'reset the tblTimer.User to the Current User Name, give Record Locking Time to Queue
   DoCmd.SetWarnings False
   DoCmd.RunSQL "UPDATE tblTimer SET tblTimer.[User] = '" & _
    Me.User & "' WHERE (((tblTimer.Func)='Add Data'));"
   DoCmd.SetWarnings True
   Exit Sub
Else
   'Do the button stuff (append query)

This code is intended to make sure that only one user at time can add records to the table. If your entry fails, then I update the tblTimer.user to the current user name. This way, you are moved to the top of the Queue. Unfortunately, with the 1 second lag between network and front ends, if the buttons are clicked at exactly the same time, this method still fails.

Any suggestions..

 

[llkhoutx]

Check the following in the Access Help Menu or the hard bound reference of your choice (esp. Litwin):

Transaction Begin
Transaction Commit
Transaction Rollback

Another solution to your problem I've seen is to generate and keep the index of a table in a separate table.

If your program is not split into a front-end (program) and back-end (data), your problem can be magnified. I've worked with large multi-user systems with the database split, and seldom, if ever had any collisions. I'll bet your database is not split or that you have have intensive data input. SQL Server back-ends help with the latter.

Commit/Rollback always works, but it's a bear to code until you get used to it. Rollback was especially prolematic for me, that is, what you do when there's a user collision. It's different for most situtations.

 

[sambo]

I'm intrigued by your answer, unfortunately, my Access Help Reference has failed for about half of the function calls and DAO objects. So I can't search for help. I tried repairing it about 10 times, but to no avail.

Do you have any application specific suggestions on how I would get started in using the methods mentioned above?

 

[sambo]

I found a good post here...

Will using this method keep the .mdb from being corrupted? In other words, hasn't the damage already been done regardless if the transmission commits or not?

 

[sambo]

DOH!!

I think I opened an entire can of worms here. Unfortunately, I'll have to address a number of things if I'm going to implement this method.

My actual psuedocode goes like this...

On_Event
On Error GoTo UpdateError
Dim wrkDefault As Workspace, bolUpdatePending As Boolean, bolUpdatePending = False

Set wrkDefault = DBEngine.Workspaces(0)
wrkDefault.BeginTrans  'start the transmission
bolUpdatePending = True  'flag the transmission as in process

If condition1<>True Then  'condition1 (serial doesn't exist)

  Call addSerialNum  'add the serial number to tblUnits
  Call inspectIncr  'add the increment (child record under tblUnits)
  Call addSpecs  'add the specs (child records under inspectIncr)

Else  (serial number already exists)

  'No need to add the serial number, it already exists
  Call inspectIncr 'add the increment (child record under tblUnits)
  Call addSpecs 'add the specs (child records under inspectIncr)

End If

wrkDefault.CommitTrans  'do the transmission

UpdateError_Exit:
  Set wrkDefault = Nothing
  Exit Sub
UpdateError:
  'If transmission in process then rollback and undo work
  If bolUpdatePending = True Then
    wrkDefault.Rollback
  End If

As soon as I call any functions which add records to tables, I am locked out of the tables because the transmission that I am in the middle of has locked me out. So not only am I locking others out, but I am also locking myself out.

Do I need to do the transmission controlling insid of the functions instead of in aggregate?

ie.. put transmission code in Func addSerial, addInspIncr, addSpecs...

I'm kind of getting lost here. Any suggestions??

 

[sambo]

DOH!!

I think I opened an entire can of worms here. Unfortunately, I'll have to address a number of things if I'm going to implement this method.

My actual psuedocode goes like this...

On_Event
On Error GoTo UpdateError
Dim wrkDefault As Workspace, bolUpdatePending As Boolean, bolUpdatePending = False

Set wrkDefault = DBEngine.Workspaces(0)
[COLOR=darkblue]wrkDefault.BeginTrans  'start the transmission[/COLOR] 
bolUpdatePending = True  'flag the transmission as in process

If condition1<>True Then  'condition1 (serial doesn't exist)

  Call addSerialNum  'add the serial number to tblUnits
  Call inspectIncr  'add the increment (child record under tblUnits)
  Call addSpecs  'add the specs (child records under inspectIncr)

Else  (serial number already exists)

  'No need to add the serial number, it already exists
  Call inspectIncr 'add the increment (child record under tblUnits)
  Call addSpecs 'add the specs (child records under inspectIncr)

End If

wrkDefault.CommitTrans  'do the transmission

UpdateError_Exit:
  Set wrkDefault = Nothing
  Exit Sub
UpdateError:
  'If transmission in process then rollback and undo work
  If bolUpdatePending = True Then
    wrkDefault.Rollback
  End If

As soon as I call any functions which add records to tables, I am locked out of the tables because the transmission that I am in the middle of has locked me out. So not only am I locking others out, but I am also locking myself out.

Do I need to do the transmission controlling insid of the functions instead of in aggregate?

ie.. put transmission code in Func addSerial, addInspIncr, addSpecs...

I'm kind of getting lost here. Any suggestions??

 

[llkhoutx]

You don't have a "Transmission BEGIN."

 

[sambo]

See above..
The blue line is the same thing isn't it?

I am beginning to see the light with this. I can tell that the benefit will be immense.

I stepped through my code and have found a problem. In my second Function Call (addIncrement) I am using Dlookup to get the Primary Key Value (autonum) of the Serial Number that I added in Function addSerial. The only problem is that I have not used the CommitTrans Function Call at this time, so technically, the Record doesn't exist yet, and thus, I can't "lookup" its Primary Key Value.

I am racking my brain trying to think of a workaround.
Here's the problem..
I need SerialNumID in for my foreign key value in the child table (InspIncr) but I can't technically look it up because its not technically there yet.

llk..
I've searched BeginTrans on this site to find many examples of you counseling people w/ suggestions on using this method. In fact, you seem to be the source, so any help would be appreciated.

 

[llkhoutx]

Here's ad ADO example:

Public Sub TestSQLTrans(fCommit As Boolean)
Dim cnx As ADODB.Connection
Dim cmd As ADODB.Command

Set cnx = CurrentProject.Connection
Set cmd = New ADODB.Command

Set cmd.ActiveConnection = cnx
cmd.CommandType = adCmdText
cmd.CommandText = "BEGIN TRANSACTION"
cmd.Execute

cmd.CommandText = "DELETE FROM tblMenu WHERE MenuId > 5"
cmd.Execute

If fCommit Then
cmd.CommandText = "COMMIT"
Else
cmd.CommandText = "ROLLBACK"
End If
cmd.Execute

Set cmd = Nothing
End Sub

 

[sambo]

I'm still having problems with this...

I don't think my rollback is working properly. I have successfully trapped the error. I am also able to re-create the error. If I simply run the following Procedure from 2 machines at the same time, the Database .mdb is corrupted and no longer works. Here is my sample program..

Public Function addSpecs() As Boolean
On Error GoTo AddSpecsError

Dim IncID As Integer, db As DAO.Database, CatEl As String
Dim rst1 As DAO.Recordset, CatID As Integer, skuSql As String, specInProc As Boolean
Dim secSpace As Workspace
Set secSpace = DBEngine.Workspaces(0)
 
 specInProc = False  'initialize flag to false
   secSpace.BeginTrans  'start the category change transmission
 specInProc = True   'set the flag to true (transmission in process)
 
 'get the correct IncID (primary key value) from qryInspID
 IncID = DLookup("[IncID]", "qryInspID", "[SerialNum] = '" & Me.SerialNum & "'")
 
 Set db = CurrentDb
 Set rst1 = db.OpenRecordset("tblCategory", dbOpenDynaset)  'open tblCategory
 With rst1
    .AddNew  'add new record
    !InspectionID = IncID  'Populate Foreign Key Field w/ IncID (see above)
    !Category = Me.txtPhase  'Popluate correct phase
    .Update
 End With
 secSpace.CommitTrans  'send the category change transmission
 secSpace.BeginTrans  'start the update query transmission
          
 'get the correct CatID (primary key value) from qryCatID
 CatID = DLookup("[CatID]", "qryCatID", "[SerialNum] = '" & _
      Me.SerialNum & "'")
         
 'append query that appends correct sub-categories into tblSubCategory
 skuSql = "INSERT INTO tblSubCategory ( SubCategory, CategoryID ) " & _
    "SELECT SubCatList.SubCatElement, " & CatID & _
    " FROM CatList INNER JOIN (SubCatList INNER JOIN (SKU INNER JOIN " & _
    "SkuSubCatJoin ON " & _
    "SKU.SKUID = SkuSubCatJoin.SKUID) ON SubCatList.SubCatListID = " & _
    "SkuSubCatJoin.SubCatListID) ON CatList.CatListID = SubCatList.CatListID " & _
    "WHERE (((SKU.GMPartNumber)= '" & Me.SerialSKU & "') AND " & _
    "((CatList.CatElement) = '" & Me.txtPhase & "'));"
   
 DoCmd.SetWarnings False
   DoCmd.RunSQL skuSql  'Run the append query
 DoCmd.SetWarnings True
 
 secSpace.CommitTrans  'send the update query transmission
 specInProc = False  'process completed (set flag to false)
 addSpecs = True  'we made it this far, everything is a go

AddSpecsError_Exit:
  Set rst1 = Nothing  'clear vars
  Set db = Nothing
  Set secSpace = Nothing
  Exit Function
AddSpecsError:
  If specInProc = True Then  'transmission was in process, so undo transmission
    addSpecs = False  'return false
    secSpace.Rollback  'perform the rollback
  End If
  GoTo AddSpecsError_Exit
End Function

Is it bad to use 2 .CommitTransmission Calls in the same procedure?
Problem...
If a user is "locked out" of the table because another user is currently running the same Procedure, then the Function Returns FALSE...
This is good, but, the table never unlocks and I get the little Warning in table view that this table has been locked by another user and cannot be edited. At this time I am forced to Exit and Repair.

Suggestions??

 

[sambo]

I'm still having problems with this...

I don't think my rollback is working properly. I have successfully trapped the error. I am also able to re-create the error. If I simply run the following Procedure from 2 machines at the same time, the Database .mdb is corrupted and no longer works. Here is my sample program..

Public Function addSpecs() As Boolean
On Error GoTo AddSpecsError

Dim IncID As Integer, db As DAO.Database, CatEl As String
Dim rst1 As DAO.Recordset, CatID As Integer, skuSql As String, specInProc As Boolean
Dim secSpace As Workspace
Set secSpace = DBEngine.Workspaces(0)
 
 specInProc = False  'initialize flag to false
   secSpace.BeginTrans  'start the category change transmission
 specInProc = True   'set the flag to true (transmission in process)
 
 'get the correct IncID (primary key value) from qryInspID
 IncID = DLookup("[IncID]", "qryInspID", "[SerialNum] = '" & Me.SerialNum & "'")
 
 Set db = CurrentDb
 Set rst1 = db.OpenRecordset("tblCategory", dbOpenDynaset)  'open tblCategory
 With rst1
    .AddNew  'add new record
    !InspectionID = IncID  'Populate Foreign Key Field w/ IncID (see above)
    !Category = Me.txtPhase  'Popluate correct phase
    .Update
 End With
 secSpace.CommitTrans  'send the category change transmission
 secSpace.BeginTrans  'start the update query transmission
          
 'get the correct CatID (primary key value) from qryCatID
 CatID = DLookup("[CatID]", "qryCatID", "[SerialNum] = '" & _
      Me.SerialNum & "'")
         
 'append query that appends correct sub-categories into tblSubCategory
 skuSql = "INSERT INTO tblSubCategory ( SubCategory, CategoryID ) " & _
    "SELECT SubCatList.SubCatElement, " & CatID & _
    " FROM CatList INNER JOIN (SubCatList INNER JOIN (SKU INNER JOIN " & _
    "SkuSubCatJoin ON " & _
    "SKU.SKUID = SkuSubCatJoin.SKUID) ON SubCatList.SubCatListID = " & _
    "SkuSubCatJoin.SubCatListID) ON CatList.CatListID = SubCatList.CatListID " & _
    "WHERE (((SKU.GMPartNumber)= '" & Me.SerialSKU & "') AND " & _
    "((CatList.CatElement) = '" & Me.txtPhase & "'));"
   
 DoCmd.SetWarnings False
   DoCmd.RunSQL skuSql  'Run the append query
 DoCmd.SetWarnings True
 
 secSpace.CommitTrans  'send the update query transmission
 specInProc = False  'process completed (set flag to false)
 addSpecs = True  'we made it this far, everything is a go

AddSpecsError_Exit:
  Set rst1 = Nothing  'clear vars
  Set db = Nothing
  Set secSpace = Nothing
  Exit Function
AddSpecsError:
  If specInProc = True Then  'transmission was in process, so undo transmission
    addSpecs = False  'return false
    secSpace.Rollback  'perform the rollback
  End If
  GoTo AddSpecsError_Exit
End Function

Is it bad to use 2 .CommitTransmission Calls in the same procedure?
Problem...
If a user is "locked out" of the table because another user is currently running the same Procedure, then the Function Returns FALSE...
This is good, but, the table never unlocks and I get the little Warning in table view that this table has been locked by another user and cannot be edited. At this time I am forced to Exit and Repair.

Suggestions??