Provided by Allen Browne, allen@allenbrowne.com
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
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim i As Integer
Dim fld As DAO.Field
Dim sFieldName As String
Dim vMaxID As Variant
Dim sSQL As String
Dim sMsg As String
lNum = lNum - 1
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
'
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