Hi Tim
I cannot imagine why you would want to do this, but the following code will
help:
Public Function ResetAutonumber( _
sTable As String, _
Optional sField As String, _
Optional lSeed As Long _
) As Long
'sTable = Table containing autonumber field
'sField = Name of the autonumber field
' (default is the first Autonumber field found in the table)
'lSeed = Long integer value you want to use for next AutoNumber
' (default is one more than the current maximum)
Dim cnn As Object 'ADODB.Connection
Dim cat As Object 'ADOX.Catalog
Dim col As Object 'ADOX.Column
Dim tbl As Object 'ADOX.Table
Dim sRemoteTable As String
On Error GoTo ProcErr
Set cat = CreateObject("ADOX.Catalog")
cat.ActiveConnection = CurrentProject.Connection
Set tbl = cat.Tables(sTable)
If tbl.Type = "LINK" Then
Set cnn = CreateObject("ADODB.Connection")
cnn.Open _
CurrentProject.Connection.ConnectionString & ";" & _
"Data Source=" & _
tbl.Properties("Jet OLEDB:Link Datasource")
cat.ActiveConnection = cnn
sRemoteTable = tbl.Properties("Jet OLEDB:Remote Table Name")
Set tbl = cat.Tables(sRemoteTable)
End If
If Len(sField) = 0 Then
For Each col In tbl.Columns
If col.Properties("AutoIncrement") Then
sField = col.name
Exit For
End If
Next
If Len(sField) = 0 Then GoTo ProcEnd
Else
Set col = tbl.Columns(sField)
End If
If lSeed = 0 Then
lSeed = Nz(DMax(sField, sTable), 0) + 1
End If
col.Properties("Seed") = lSeed
ResetAutonumber = lSeed
ProcEnd:
On Error Resume Next
If Not cnn Is Nothing Then
cnn.Close
Set cnn = Nothing
End If
Set col = Nothing
Set tbl = Nothing
Set cat = Nothing
Exit Function
ProcErr:
MsgBox Err.Description
Resume ProcEnd
End Function
--
Good Luck!
Graham Mandeno [Access MVP]
Auckland, New Zealand
Return mail address is invalid in a vain attempt to reduce spam.
Feedback is welcome at: (e-mail address removed)
Please post new questions or followups to newsgroup.
