Public Function FixAutoNumberFields(DatabaseFile As String, TableName As String, FieldName As String, NewSeed As Long) As Boolean



   'Note:    Requires reference to Microsoft ADO Ext. library.

  

   Dim bReturn             As Boolean              'Function Return

   Dim cnn                 As ADODB.Connection     'ADO Connection

   Dim cat                 As New ADOX.Catalog     'ADOX Catalog of current project.

   Dim tbl                 As ADOX.Table           'ADOX table

   Dim col                 As ADOX.Column          'ADOX field

   Dim sMsg                As String               'MsgBox message.

  

   Set cnn = New ADODB.Connection

   Set cat = New ADOX.Catalog

  

   cnn.Open "Provider='Microsoft.Jet.OLEDB.4.0';Data Source= '" & DatabaseFile & "';"

   Set cat.ActiveConnection = cnn

   Set tbl = cat.Tables.Item(TableName)

   Set col = tbl.Columns.Item(FieldName)

   If col.Properties("Autoincrement") Then

     If col.Type = adInteger Then

       '  Update Old and New Seed Values

       .lOldSeed = col.Properties("Seed")

       col.Properties("Seed") = NewSeed

       bReturn = True

    End If

  End If      



Exit_FixAutoNumberFields:

   FixAutoNumberFields = bReturn

   Set cnn = Nothing

   Set col = Nothing

   Set tbl = Nothing

   Set cat = Nothing

   Exit Function



Err_FixAutoNumberFields:

   sMsg = "ERROR (" & Err.Number & ") on line (" & Erl & ") - " & Err.Description

   MsgBox sMsg, vbExclamation, "FixAutoNumberFields ERROR"

   Resume Exit_FixAutoNumberFields

  

End Function

Me.PartSortID=Int(Nz(DMax("[PartSortID]", "tblParts","[SectionID]='" & Me.SectionID & "'" & _
                            " And [TowerID]='" & Me.TowerID & "'"),0)/10) * 10 + 10