Lock Record for fetching Unique Document Reference

GK in the UK

Registered User.
Local time
Today, 02:36
Joined
Dec 20, 2017
Messages
281
I have a function to fetch the next unique document ID from a table.

But, I don't think it's robust if there are two users trying to fetch at the same time. What do I need to add to this code to

a) keep trying if the record is locked
b) once I have it opened, make sure it's not readable by another user

(Error handling code not added yet)

Code:
Public Function fNextDocRef(strDocType As String) As String
   
    Dim strRef As String
    Dim db As Database
    Dim rec As DAO.Recordset
    
    Set db = CurrentDb
    Set rec = CurrentDb.OpenRecordset("tbl2DocTypes", dbOpenDynaset)
    
    With rec
        .FindFirst "DocTypesID = '" & strDocType & "'"      ' find the row for eg SORD
        If Not .NoMatch Then
            .Edit
            strRef = Str(!dtNextDocNum)                     ' get the next number ...
            !dtNextDocNum = !dtNextDocNum + 1               ' ... and increment
            .Update
        End If
    End With

    strRef = TrimChar(strRef)                               ' got eg 1234
    strRef = Right("0000000" & strRef, LengthOfRefDigits)   ' now 0001234
    fNextDocRef = rec!dtPrefix & strRef                     ' now SORD0001234 (user defined prefix)

    rec.Close
    Set rec = Nothing

End Function
 
they have a field called autonum, that creates the next ID automatically.
No code needed.
 
Code:
Public Function fNextDocRef(strDocType As String) As String
   
    Dim strRef As String
    Dim db As Database
    Dim rec As DAO.Recordset
    
    Dim counter As Integer
    Set db = CurrentDb

' loop on error until we get the next ID or
' we tried 5 times.
On Error GoTo looper
counter = 1
Do While True

    Set rec = CurrentDb.OpenRecordset("tbl2DocTypes", dbOpenDynaset)
    
    With rec
        .FindFirst "DocTypesID = '" & strDocType & "'"      ' find the row for eg SORD
        If Not .NoMatch Then
            .Edit
            strRef = Str(!dtNextDocNum)                     ' get the next number ...
            !dtNextDocNum = !dtNextDocNum + 1               ' ... and increment
            .Update
        Else
            .AddNew
            !DocTypesID = strDocType
            !dtNextDocNum = 2
            .Update
            strRef = 1
        End If
    End With
    
    Exit Do
looper:
    counter = counter + 1
    SysCmd acSysCmdClearStatus
    If counter > 5 Then
        Exit Do
    End If
    SysCmd acSysCmdSetStatus, "Unknown error occured... retrying (" & Trim(counter & "") & ")"
    ' exit continuous loop if we have counter=5
    ' therefore preventing endless loop
Loop
    SysCmd acSysCmdClearStatus
    
    strRef = TrimChar(strRef)                               ' got eg 1234
    strRef = Right("0000000" & strRef, LengthOfRefDigits)   ' now 0001234

If counter < 6 then
    fNextDocRef = rec!dtPrefix & strRef                     ' now SORD0001234 (user defined prefix)
End If
    rec.Close
    Set rec = Nothing

End Function
 
Last edited:
That looks like just what I need, thanks, I can work with that.

Question:

The line

Code:
Set rec = CurrentDb.OpenRecordset("tbl2DocTypes", dbOpenDynaset)
Should I change dbOpenDynaset to DbDenyRead or is this not neccesary with your solution?
 
dbOpenDynaset will be fine.
 

Users who are viewing this thread

Back
Top Bottom