Link to home
Create AccountLog in
Avatar of SteveL13
SteveL13Flag for United States of America

asked on

Fake autonumber field

I have a text field that contains up to 5 digits.  Like 00001 through 99999.  It is not an autonumber field but I want it appear as one.  In other words, the first record would be 00001 and the next one would be 00002, etc.


How can I do this?

Avatar of Jim Dettman (EE MVE)
Jim Dettman (EE MVE)
Flag of United States of America image

You need a key table to hold the last value used for each table you'd use this with, and then a routine something like this:

'
' Get a unique record key.
'
Function GetRecordKey(strTableName As String) As Variant

        Const Routine = "GetRecordKeys"
        Const Version = "1.0"

        Dim dbCurrent As Database
        Dim dbRemote As Database
        Dim tdfAttached As TableDef
        Dim strPath As String
        Dim rst1 As Recordset
        Dim rst2 As Recordset
        Dim lngKeyValue As Long
        Dim lngWait As Long
        Dim lngX As Long
        Dim intLockCount As Integer

10      On Error GoTo GetRecordKeyError

20      GetRecordKey = Null

30      Set dbCurrent = curDB()

        '
        ' First, get the key type.
        '
40      Set rst1 = dbCurrent.OpenRecordset("tblCounterTable", dbOpenDynaset)
50      rst1.FindFirst "[TableName]= '" & strTableName & "'"

60      If rst1.NoMatch Then
          ' Not good.  Need an entry for the table to generate a key.
70        MsgBox "No key table entry."
80        GoTo GetRecordKeyExit
90      End If

        '
        ' Now Generate a key
        '
GetAKey:
100     Select Case rst1![KeyType]

          Case 1
            ' Key is simple numeric counter (ie xxxxxxx).  rst1.Edit
110         lngKeyValue = rst1![LastKeyValue] + 1
120         rst1![LastKeyValue] = lngKeyValue
130         rst1.Update
140         GetRecordKey = lngKeyValue

            'Case 2
            ' Key is a base + a numeric counter (ie.  ABAxxx)

150       Case Else
            ' Undefined key type
160         MsgBox "No key table entry."
170         GoTo GetRecordKeyExit

180     End Select

        '
        ' Got a key.  Does it need to be tested for unique?
        ' Note assumes a JET linked table.
        '
190     If (rst1![UniqueKey]) Then
200       Set tdfAttached = dbCurrent.TableDefs(strTableName)
210       strPath = tdfAttached.Connect
220       If strPath <> "" Then
230         If dbRemote Is Nothing Then
240           strPath = right$(strPath, Len(strPath) - InStr(strPath, "="))
250           Set dbRemote = Workspaces(0).OpenDatabase(strPath, False, True)
260           Set rst2 = dbRemote.OpenRecordset(strTableName, DB_OPEN_TABLE)
270         End If
280       Else
290         Set rst2 = dbCurrent.OpenRecordset(strTableName, DB_OPEN_TABLE)
300       End If

310       rst2.Index = "PrimaryKey"
320       rst2.Seek "=", lngKeyValue

330       If Not (rst2.NoMatch) Then
340         rst2.Close
350         GoTo GetAKey
360       Else
370         rst2.Close
380       End If

390     End If

GetRecordKeyExit:
400     On Error Resume Next

410     rst1.Close
420     Set rst1 = Nothing

430     rst2.Close
440     Set rst2 = Nothing

450     dbRemote.Close
460     Set dbRemote = Nothing

470     Set dbCurrent = Nothing

480     Exit Function

GetRecordKeyError:
        'Table locked by another user
490     If Err = CNT_ERR_RESERVED Or Err = CNT_ERR_COULDNT_UPDATE Or Err = CNT_ERR_OTHER Then
500       intLockCount = intLockCount + 1
510       If intLockCount > 5 Then
520         GetRecordKey = Null
530         Resume GetRecordKeyExit
540       Else
550         DoEvents
560         DBEngine.Idle DB_FREELOCKS
570         lngWait = intLockCount ^ 2 * Int(Rnd * 20 + 5)
580         For lngX = 1 To lngWait
590           DoEvents
600         Next lngX
610         Resume
620       End If
630     Else
640       MsgBox "Unexpected error"
650       GetRecordKey = Null
660       Resume GetRecordKeyExit
670     End If

End Function

Open in new window



Key table looks like this:

User generated image
Note that the procedure is an example and won't work right off.   It has some things in it like CurDB() instead of CurrentDB(), but it's very close to what you would need.

Jim.
ASKER CERTIFIED SOLUTION
Avatar of Gustav Brock
Gustav Brock
Flag of Denmark image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
You can't use DMax in a multi-user situation.   You can get duplicates that way.  That's why you need to use a key table to hold the last value assigned and hold a lock while you update the value.

Jim.
Avatar of SteveL13

ASKER

This is a single-user environment but thanks for the tip Jim.


Gustav, how do I get the form to display the new number?  Right now, I know it is there but not displaying until I close and re-open the form to that new record.

Bind the textbox to the pseudo ID.

When you enter something in another bound textbox on the form in a new record, the new ID will display at once forced by this line:

Me!PseudoId.Value = NextId

Open in new window

Not working when I enter something in another field.  Here's my code:


Private Sub Form_BeforeUpdate(Cancel As Integer)

On Error GoTo Err_Form_BeforeUpdate

    

    Const DigitCount    As Integer = 5

    

    Dim LastId          As String

    Dim NextId          As String

    

    LastId = Nz(DMax("FileNsuffix", "tblOceanImports"), "0")

    NextId = Right(String(DigitCount, "0") & CStr(Val(LastId) + 1), DigitCount)

    

    Me!txtFileNsuffix.Value = NextId


Exit_Form_BeforeUpdate:

    Exit Sub


Err_Form_BeforeUpdate:

    MsgBox "Error Number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description & vbCrLf & "Error Source: " & Err.Source

    Resume Exit_Form_BeforeUpdate


End Sub


Use the BeforeInsert event.
This is a single-user environment but thanks for the tip Jim.

Can't tell you how many times I've heard that...what's true now might is not always true in the future.

Jim.

Perfect!