Option Compare Database
Option Explicit
Function ChangeSeed(strTbl As String, strCol As String, lngSeed As Long) As Boolean ''' use the ResetSeed function. it finds the new seed.
'You must pass the following variables to this function.
'strTbl = Table containing autonumber field
'strCol = Name of the autonumber field
'LngSeed = Long Integer value you want to use for next AutoNumber.
Dim cnn As ADODB.Connection
Dim cat As New ADOX.Catalog
Dim col As ADOX.Column
'Set connection and catalog to current database
Set cnn = CurrentProject.Connection
cat.ActiveConnection = cnn
Set col = cat.Tables(strTbl).Columns(strCol)
col.Properties("Seed") = lngSeed
cat.Tables(strTbl).Columns.Refresh
If col.Properties("Seed") = lngSeed Then
ChangeSeed = True
Else
ChangeSeed = False
End If
Set col = Nothing
Set cat = Nothing
Set cnn = Nothing
End Function
Function ResetSeed(strTable As String) As String
'Purpose: Reset the Seed of the AutoNumber, using ADOX.
Dim strAutoNum As String 'Name of the autonumber column.
Dim lngSeed As Long 'Current value of the Seed.
Dim lngNext As Long 'Next unused value.
Dim strSQL As String
Dim strResult As String
lngSeed = GetSeedADOX(strTable, strAutoNum)
If strAutoNum = vbNullString Then
strResult = "AutoNumber not found."
Else
lngNext = Nz(DMax(strAutoNum, strTable), 0) + 1
If lngSeed = lngNext Then
strResult = strAutoNum & " already correctly set to " & lngSeed & "."
Else
Debug.Print "lngnext = " & lngNext, "lngSeed = "; lngSeed
'strSQL = "ALTER TABLE [" & strTable & "] ALTER COLUMN [" & strAutoNum & "] COUNTER(" & lngNext & ", 1);"
strSQL = "ALTER TABLE [" & strTable & "] ALTER COLUMN " & strAutoNum & " COUNTER(" & lngNext & ", 1);"
Debug.Print strSQL
CurrentProject.Connection.Execute strSQL
strResult = strAutoNum & " reset from " & lngSeed & " to " & lngNext
End If
End If
ResetSeed = strResult
End Function
Function GetSeedADOX(strTable As String, Optional ByRef strCol As String) As Long
'Purpose: Read the Seed of the AutoNumber of a table.
'Arguments: strTable the table to examine.
' strCol = the name of the field. If omited, the code finds it.
'Return: The seed value.
''' requires reference to ADO Ext. 2.8 for DDL and Security library
Dim cat As New ADOX.Catalog 'Root object of ADOX.
Dim tbl As ADOX.Table 'Each Table in Tables.
Dim col As ADOX.Column 'Each Column in the Table.
'Point the catalog to the current project's connection.
Set cat.ActiveConnection = CurrentProject.Connection
Set tbl = cat.Tables(strTable)
'Loop through the columns to find the AutoNumber.
For Each col In tbl.Columns
If col.Properties("Autoincrement") Then
strCol = "[" & col.Name & "]"
GetSeedADOX = col.Properties("Seed")
Exit For 'There can be only one AutoNum.
End If
Next
'Clean up
Set col = Nothing
Set tbl = Nothing
Set cat = Nothing
End Function