Function CodeGenerate () As String
    '*********************************************************************
    '****** Author: Charles Kangai, Blueneck Computer Training ***********
    '****** 9 Chandos Road, Redland, Bristol, BS6 6PG, United Kingdom ****
    '****** Tel: 0117- 974 4416  Fax: 0117- 923 8172  ********************
    '****** Compuserve: 100424,1710                   ********************
    '*********************************************************************
    'Somebody recently asked me how to generate alphanumeric code
    'sequences in Access, i.e. AA000, AA001, AA002, ..., AA999, AB000, ...
    'Here is one solution:
    '1. Create a table, here called 'tblCounter and include one field in it.
    '   The field must be of Long Integer data type. The table will only ever
    '   have one record in it. You use this field as a counter.
    '2. Enter an initial value of 0 in the field to initialise the counter.
    '3. Use this function to generate the code.
    '*********************************************************************
    '                      Blueneck Computer Training, 1995
    'Code for generating alphanumeric code sequencies: AA000, AA001, ....,AA999, AB000, etc.
    'To call this code from your program, just call function CodeGenerate()
    '*********************************************************************
    Dim db As Database, rs As Recordset, Counter As Long, retry As Integer
    Dim iFF As Integer, iSS As Integer, iTT As Integer, code As String
    On Error GoTo ErrorCodeGenerate
    Set db = dbEngine(0)(0)
    'Open table with the counter
    Set rs = db.OpenRecordset("tblCounter", db_Open_Dynaset)
    rs.MoveFirst
    rs.Edit
        rs!Value = rs!Value + 1
    rs.Update
    Counter = CLng(rs!Value) - 1
    iFF = Counter Mod 1000
    iSS = (Counter \ 1000) Mod 26
    iTT = (Counter \ 1000) \ 26
    'Generate the code
    code = Chr$(iTT + 65) & Chr$(iSS + 65) & Format$(iFF, "000")
    CodeGenerate = code
ExitCodeGenerate:
    Exit Function
ErrorCodeGenerate:
    'In case somebody is editing the record; trap this error
    If Err = 3188 Then
        retry = retry + 1
        If retry < 20 Then
            Resume
        Else
            'Time out retries
            MsgBox Error$, 48, "Can't autogenerate code"
            Resume ExitCodeGenerate
        End If
    Else
        'Some other error
        MsgBox Str$(Err) & " - " & Error$, 48, "Problem Generating Code"
        Resume ExitCodeGenerate
    End If
End Function
