Lock Record for fetching Unique Document Reference

[GK in the UK]

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)

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

 

[Ranman256]

they have a field called autonum, that creates the next ID automatically.
No code needed.

 

[arnelgp]

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

 

[GK in the UK]

That looks like just what I need, thanks, I can work with that.

Question:

The line

Set rec = CurrentDb.OpenRecordset("tbl2DocTypes", dbOpenDynaset)

Should I change dbOpenDynaset to DbDenyRead or is this not neccesary with your solution?

 

[arnelgp]

dbOpenDynaset will be fine.