We have multiuser system in which UPCs are assigned to products by the users. These UPCs come from a series of available UPCs. For example the available UPCs might be from 81307700000 to 81307799999. Currently the code assigns these without regard to the fact that it is possible (about 1 chance in 6 million) that the same UPC could be assigned to different products. Searching for a fix for this I came across a possible solution at https://support2.microsoft.com/defau...b;en-us;191253
To convince myself that this code would work, I added a message box to the code (see below) so that the code stops just after opening the table. When I tested this code from two computers, leaving the table open on the first, Access on the second computer freezes when the table is opened. This seems to be caused by the statement
DBEngine.SetOption dbLockDelay, 90 + Rnd * 60
In any case commenting it out eliminates the problem. Anyone know why this would cause Access to freeze up? Is there some other way to do this?
Function NextKeyValue(db As Database, _
ByVal TableName As String, _
Optional ws As Workspace = Nothing, _
Optional Increment As Long = 1) As Long
Dim rs As Recordset, ErrorCount As Long, TempKeyValue As Long
NextKeyValue = -1 ' Returns this if the routine times out
On Error GoTo NKV_Err
' Random delay between 90ms and 150ms prevents race condition
DBEngine.SetOption dbLockDelay, 90 + Rnd * 60
' use default workspace if not supplied
If ws Is Nothing Then Set ws = DBEngine(0)
' Error should occur on the next line if table is in use
' Open it exclusively
Set rs = db.OpenRecordset(TableName, dbOpenTable, _
dbDenyRead Or dbDenyWrite)
msgbox "Table is open"
DBEngine.Idle dbRefreshCache ' refresh read cache
TempKeyValue = rs(0) ' get value to use
ws.BeginTrans
rs.Edit
rs(0) = TempKeyValue + Increment ' value for next call
rs.Update
ws.CommitTrans dbForceOSFlush ' flush the lazy-write cache
rs.Close
NextKeyValue = TempKeyValue
Exit Function
NKV_Abort: ' clean up the mess
On Error Resume Next
ws.Rollback
rs.Close
Exit Function
NKV_Err:
Select Case Err.Number
Case 3008, 3009, 3189, 3211, 3260, 3261, 3262
' various locking errors (above)
ErrorCount = ErrorCount + 1
If ErrorCount > MAX_RETRIES Then
Resume NKV_Abort
Else
Resume
End If
Case Else ' unhandled errors
Err.Raise Err.Number, Err.Source, Err.Description
End Select
End Function