Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Microsoft: Access Tables and Relationships FAQ

Tables and Relationships

Why AutoNumber shouldn't be used in MultiUser databases (And How to ge the Unique Number) by MichaelRed
Posted: 16 Aug 00

In a multiuser database, it is possible to have two users attempt to add records to the database "at the same time".  This will eventually cause an error "Duplicate value in Autonumber field".  The simple way to avoid this issue is to generate your own "AutoNumber" value, using a seperate database/table which is "Locked" by the User until the value has been updated.  The Locking of the database/Table is the Key.  While one user has the database/table locked, no other user can access it to get a (duplicate) value.  The function below, generates an "Autonumber" in this manner.  This specific implementation is limited to 10,000 entries per month.  This is due to the inclusion of the Year & Month being included as a "prefix" value to the serial integer value.  Comments in the code show the areas where the Year & Month are included - so they may be easily removed for users wanting to have the simple incrementing integer.

There is never time to do it right but there is always time to do it over.
Public Function NewQI_Num() As Long

    'Submiitted to Tek-Tips.Com as Access FAQ on generating Unique ID numbers
    'in a Multi-User database.  This example Function was adapted from a commercial
    'applilcation with approximatly 50 concurrent users and was in-service for over
    'a year with out "Timing-Out" with the Retry value of 20.

    'MichaelRed 8/15/2000.
    'There is Never time to do it right but there is always time to do it over

    On Error GoTo NewQiNum_Err

    Dim MyDbs As Database        'Substitute Your Database Name Here
    Dim BaseData As Recordset
    Dim tblNewQiNum As Recordset
    Dim qSelQiMax As Recordset

    'Constants for the expected errors
    Const RiErr = 3000
    Const LockErr = 3260
    Const InUseErr = 3262
    Const NumReTries = 20#          'This is just a number of attempts
                                    'we will make internally to this Function
                                    'it is set to a nominal value, which works
                                    'for moderate (~ 50 Users).  It could be set
                                    'to any arbitrary value, however the
                                    'expectation it that it will NEVER Fail

    'Variables for the Retry count
    Dim NumLocks As Integer
    Dim lngX As Long

    'Variables used in the Code.
    'Not that this implementation "wants" part of the Date (Year & Month)
    ' to be "Encoded" in the Unique Id, otherwise we could dispense with
    'most of these vars - and there use/calculation below
    Dim QiNum As Long
    Dim lngOldQiNum As Long
    Dim lngNewQiNum As Long
    Dim lngBigQiNum As Long
    Dim QiYear As Long
    Dim QiMnth As String
    Dim strQINum As String

    'Remember to Use your DataBase Name
    Set MyDbs = CurrentDb()
    Set BaseData = MyDbs.OpenRecordset("Basic Data")

    'Get the date part of the Id
    QiYear = Format(Now, "yyyy")
    QiMnth = Format(Now(), "mm")
    strQINum = QiYear & QiMnth

    'Get the Lowest possible value for an ID for the current Date
    'This is a good place to remind everyone that all of the
    'System (e.g. individual computer) Clocks MUST be synchronized!!!!
    'the const vlaue (1000) is selected as a number >> the number of
    'ID's we expect in the time period before Resetting the Prefix (e.g. Monthly)
    QiNum = Val(strQINum) * 10000               'B

    'For the convienience of readers the SQl from the Query is given
    'Again, please be careful to use YOUR recordset (name)
    'SELECT Max([Basic Data].Qi) AS Qi FROM [Basic Data];

    'Get the Currently assigned Highest value.  Again, this is only
    'necessary because this implememtation 'wants the year & month in the Stamp
    'Also, note the dbDenyRead.  This assures us that - if we get access to the info,
    'We have SOLE access to it.  No one else can get past here untill we are done.
    Set qSelQiMax = MyDbs.OpenRecordset("qSelQiMax", dbDenyRead)
    Set tblNewQiNum = MyDbs.OpenRecordset("tblNewQiNum", dbDenyRead)

    'tblNewQiNum has only two fields, [QiNum] & [QiDateTime].
    'It only has a single record, so when we open the recordset, we are on
    'the first record, and these values are immediatly available

    'Again, this - except for the incrementing below - is just ot incorporate
    'the Year and Month into the value as a Prefix.
    lngOldQiNum = qSelQiMax!QI                  'A
    lngNewQiNum = tblNewQiNum!QiNum             'C
    lngBigQiNum = lngNewQiNum                   'Big = C   (Assume C is the Answer)
    If (lngOldQiNum > lngBigQiNum) Then         'IF (A >= Big) Then
        lngBigQiNum = lngOldQiNum               '   Big = A
    End If                                      'End If

    If (QiNum > lngBigQiNum) Then               'If (B >= Big) Then
        lngBigQiNum = QiNum                     '   Big = B
    End If                                      'End If
    'Increment the ID
    lngBigQiNum = lngBigQiNum + 1

    'Update the Id value and (just for my own interest) the date/time stamp
    With tblNewQiNum
            !QiNum = lngBigQiNum
            !QiDateTime = Now()
    End With
    NewQI_Num = lngBigQiNum

    Set BaseData = Nothing
    Set MyDbs = Nothing

    Exit Function           'Return


    'This is the part where we wait if another user is getting a New ID

    'Check for the Expected errors
    If ((Err = InUseErr) Or (Err = LockErr) Or (Err = RiErr)) Then

        'If one of the expected ones, Increment the Counter
        NumLocks = NumLocks + 1

        If (NumLocks < NumReTries) Then     'Check for to many attempts
                                            'Failing here probably indicates
                                            'a system problem, not a real "TimeOut"

            'We generate a pseudo random value to use in the empty loop
            'it's really just a (pseudo) ramdom interval thinnnggggggyyyyyy
            For lngX = 1 To NumLocks ^ 2 * Int(Rnd * 20 + 5)
                DoEvents            'Wait in La-La land
            Next lngX
            Resume Next             'Go Back and Try Again
            'This should not happen.  20 Random retries should always
            'get a unique number.  But here is where the error handler would go
        End If
        'Unexpected Error - Also known as "Tell me the Story, the old, old story ...
        MsgBox "Error " & Err.Number & ": " & Err.Description, _
                vbOKOnly & vbCritical, "Get Qi Number"
        Go To NormExit
    End If

End Function

Back to Microsoft: Access Tables and Relationships FAQ Index
Back to Microsoft: Access Tables and Relationships Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close