AutoNumbers

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)

' Note: For Access 2, remove quote from beginning of next 3 lines.

' Const dbAutoIncrField = 16

' Const vbInformation = 64

' Const dbFailOnError = 128

Dim db As Database ' Current db.
Dim tdf As TableDef ' TableDef of sTable.
Dim i As Integer ' Loop counter
Dim fld As 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 & ": " & Error$, , "SetAutoNumber()"
Resume Exit_SetAutoNumber
End Sub