This isn't a question. I just wanted to post this little code snippit here for anyone that's interested.
The following two Functions allow you to return and change the "next used Autonumber" value of an Autonumber Type Field.
I know, generally speaking you should never design a database to rely on Autonumber Fields (to the point where, if the number changes, things get messed up). However, these functions still might be useful to someone out there!
Return the current "next Autonumber value"
Code:
Function GetAutonumber(TableName As String, FieldName As String) As Variant
' This function checks the passed Table and Field and checks to see if it is
' of type autonumber.
' Returns Boolean FALSE if the Field is not of type Autonumber or if an
' error was encountered.
' Returns a Long number equal to the current "next Autonumber" value of the
' Field if it is of type Autonumber.
' TableName - The Table containing the Autonumber Field to be updated.
' Required.
' FieldName - The Autonumber Field/Column name to be updated. Required.
' Requires "Microsoft ADO Extension 2.x for DDL and Security" Reference Library!.
On Error GoTo Error_GetAutonumber
Dim catDB As New ADOX.Catalog
Dim rstTable As New ADOX.Table
Dim rstField As New ADOX.Column
' Connect to the currently open database with the default Provider.
Set catDB.ActiveConnection = CurrentProject.Connection
' Attempt to open TableName and FieldName. If either TableName or FieldName
' do not exist or are locked, no error will be shown. Instead, the Function
' will simply return Boolean FALSE.
Set rstTable = catDB.Tables(TableName)
Set rstField = rstTable.Columns(FieldName)
GetAutonumber = False
' If a Field is Autonumber, it will have the "Autoincrement" Property set to
' True.
If rstField.Properties("Autoincrement") = True Then
' It's an autonumber field, so change the return value from FALSE to the
' current "seed" value.
GetAutonumber = CLng(rstField.Properties("seed"))
End If
FunctionClosing:
' Clean up our Object variables.
Set rstTable = Nothing
Set rstField = Nothing
Set catDB = Nothing
' Exit the Function, passing back our return value.
Exit Function
Error_GetAutonumber:
' If we encounter an error, make sure the return value is set to FALSE.
GetAutonumber = False
' Clean up our Object variables and exit the Function!
Resume FunctionClosing
End Function
Set the "next Autonumber value"
Code:
Function SetAutonumber(TableName As String, FieldName As String, NewValue As Long) As Variant
' This function changes the passed Table and Field's "next Autoincrement"
' value to NewValue.
' Returns Boolean FALSE if an error was encountered.
' Returns Boolean TRUE if the new "seed" value was successfully updated.
' TableName - The Table containing the Autonumber Field to be updated.
' Required.
' FieldName - The Autonumber Field/Column name to be updated. Required.
' NewValue - The new seed value for the Autonumber Field. This will be the
' next value assigned when a new Record is created. Note that the seed
' value can be set to a number already used. If this is the case, this
' function will successfully update the seed value, but no new Records
' will be able to be added to the Table due to a "duplicate key" error.
' Required.
' Requires "Microsoft ADO Extension 2.x for DDL and Security" Reference Library!.
On Error GoTo Error_SetAutonumber
Dim catDB As New ADOX.Catalog
Dim rstTable As New ADOX.Table
Dim rstField As New ADOX.Column
' Connect to the currently open database with the default Provider.
Set catDB.ActiveConnection = CurrentProject.Connection
' Attempt to open TableName and FieldName. If either TableName or FieldName
' do not exist or are locked, no error will be shown. Instead, the Function
' will simply return Boolean FALSE.
Set rstTable = catDB.Tables(TableName)
Set rstField = rstTable.Columns(FieldName)
' Set the default return value of TRUE.
SetAutonumber = True
' If a Field is Autonumber, it will have the "Autoincrement" Property set to
' True.
If rstField.Properties("Autoincrement") = True Then
' It's an autonumber field, so attempt to update the "seed" value.
rstField.Properties("seed") = NewValue
End If
FunctionClosing:
' Clean up our Object variables.
Set rstTable = Nothing
Set rstField = Nothing
Set catDB = Nothing
' Exit the Function, passing back our return value.
Exit Function
Error_SetAutonumber:
' If we encounter an error, make sure the return value is set to FALSE.
SetAutonumber = False
' Clean up our Object variables and exit the Function!
Resume FunctionClosing
End Function