Set AutoNumbers to start from ...

 

Resetting an AutoNumber to 1 is easy: delete the records, and compact the database.

But how do you force an AutoNumber to start from a specified value? The trick is to import a record with one less than the desired number, and then delete it. The following sub performs that operation. For example, to force table "tblClient" to begin numbering from 7500, enter:

    Call SetAutoNumber("tblClient", 7500)

Sub SetAutoNumber(sTable As String, ByVal lNum As Long)
On Error GoTo Err_SetAutoNumber
    ' Purpose:      set the AutoNumber field in sTable to begin at lNum.
    ' Arguments:    sTable = name of table to modify.
    '               lNum = the number you wish to begin from.
    ' Sample use:   Call SetAutoNumber("tblInvoice", 1000)
    Dim db As DAO.Database      ' Current db.
    Dim tdf As DAO.TableDef     ' TableDef of sTable.
    Dim i As Integer            ' Loop counter
    Dim fld As DAO.Field        ' Field of sTable.
    Dim sFieldName As String    ' Name of the AutoNumber field.
    Dim vMaxID As Variant       ' Current Maximum AutoNumber value.
    Dim sSQL As String          ' Append/Delete query string.
    Dim sMsg As String          ' MsgBox string.

    lNum = lNum - 1             ' Assign to 1 less than desired value.

    ' Locate the auto-incrementing field for this table.
    Set db = CurrentDb()
    Set tdf = db.TableDefs(sTable)
    For i = 0 To tdf.Fields.Count - 1
        Set fld = tdf.Fields(i)
        If fld.Attributes And dbAutoIncrField Then
            sFieldName = fld.name
            Exit For
        End If
    Next

    If Len(sFieldName) = 0 Then
        sMsg = "No AutoNumber field found in table """ & sTable & """."
        MsgBox sMsg, vbInformation, "Cannot set AutoNumber"
    Else
        vMaxID = DMax(sFieldName, sTable)
        If IsNull(vMaxID) Then vMaxID = 0
        If vMaxID >= lNum Then
            sMsg = "Supply a larger number. """ & sTable & "." & _
                sFieldName & """ already contains the value " & vMaxID
            MsgBox sMsg, vbInformation, "Too low."
        Else
            ' Insert and delete the record.
            sSQL = "INSERT INTO " & sTable & " ([" & sFieldName & "]) SELECT " & lNum & " AS lNum;"
            db.Execute sSQL, dbFailOnError
            sSQL = "DELETE FROM " & sTable & " WHERE " & sFieldName & " = " & lNum & ";"
            db.Execute sSQL, dbFailOnError
        End If
    End If
Exit_SetAutoNumber:
    Exit Sub

Err_SetAutoNumber:
    MsgBox "Error " & Err.Number & ": " & Err.Description, , "SetAutoNumber()"
    Resume Exit_SetAutoNumber
End Sub
Read 50 times
Dylan Austin

About:

Whenever I have a problem, I sing. Then I realize my voice is worse than my problem.

Latest Tech News

Top
We use cookies to improve our website. By continuing to use this website, you are giving consent to cookies being used. More details…