| re: AutoNumber Regeneration
The issue of using AutoNumber keys in joins is problematic for the reasons
outlined. You should use hardcoded id's for joins to avoid the issue
altogether...
Tony D'Ambra
Web Site: aadconsulting.com
Web Blog: accessextra.net
<jimfortune@compumarc.com> wrote in message
news:1102835759.984660.84390@c13g2000cwb.googlegro ups.com...[color=blue]
> Sometimes I use Autonumber fields for ID fields. Furthermore,
> sometimes I use those same fields in orderdetail type tables. So it's
> important in that case that once an autonumber key value is assigned to
> a record that it doesn't change. Occasionally I find that due to
> corruption or an accidental deletion and restore of a record from a
> backup the autonumber field needs to be tidied up. So when I create
> (through AddNew) the autonumber key to be used for joins, I also save a
> copy in a backup ID field (Long). I could get by with always using the
> backup ID for the join but I don't like having backup ID's that are
> different from the autonumber value. I decided that I really wanted to
> regenerate the autonumber field to match the Backup ID values. I
> couldn't get the 'force update on autonumber field to previously
> deleted values' idea from a recent post to work so I created some code
> to do it. It's still a little rough but might suffice to get someone
> to point out an easier way. The code is in A97. I didn't have any RI
> to deal with. The form shows the tables in the database and once the
> table is selected, the fields populate two comboboxes for choosing the
> primary key field and the backup ID field. txtNewTableName is for the
> name of the new table with the repaired autonumber values. The main
> idea is to use AddNew without an Update until the next backup ID is
> reached.
>
> '-------Form Code
> Option Compare Database
> Option Explicit
>
> Private Sub cbxDatabaseTable_AfterUpdate()
> Dim MyDB As Database
> Dim tdf As TableDef
> Dim fld As Field
>
> If IsNull(cbxDatabaseTable.Value) Then
> cbxIDFieldName.RowSource = ""
> cbxBackupIDFieldName.RowSource = ""
> cbxIDFieldName.Value = Null
> cbxBackupIDFieldName.Value = Null
> Exit Sub
> End If
> 'Put the field names in cbxIDFieldName and cbxBackupIDFieldName
> Set MyDB = CurrentDb
> cbxIDFieldName.RowSourceType = "Value List"
> cbxBackupIDFieldName.RowSourceType = "Value List"
> For Each fld In MyDB.TableDefs(cbxDatabaseTable.Value).Fields
> If Nz(cbxIDFieldName.RowSource, "") = "" Then
> cbxIDFieldName.RowSource = fld.Name
> Else
> cbxIDFieldName.RowSource = cbxIDFieldName.RowSource _
> & ";" & fld.Name
> End If
> If Nz(cbxBackupIDFieldName.RowSource, "") = "" Then
> cbxBackupIDFieldName.RowSource = fld.Name
> Else
> cbxBackupIDFieldName.RowSource = cbxBackupIDFieldName.RowSource _
> & ";" & fld.Name
> End If
> Next fld
> Set MyDB = Nothing
> End Sub
>
> Private Sub cmdFixAutonumber_Click()
> If IsNull(cbxDatabaseTable.Value) Then
> MsgBox ("No table was selected.")
> Exit Sub
> End If
> If IsNull(txtNewTableName.Value) Then
> MsgBox ("No new table name was selected.")
> Exit Sub
> End If
> If IsNull(cbxIDFieldName.Value) Then
> MsgBox ("No ID Field was selected.")
> Exit Sub
> End If
> If IsNull(cbxBackupIDFieldName.Value) Then
> MsgBox ("No Backup ID Field was selected.")
> Exit Sub
> End If
> Call FixAutoNumber(cbxDatabaseTable.Value, txtNewTableName.Value, _
> cbxIDFieldName.Value, cbxBackupIDFieldName.Value)
> MsgBox ("Done.")
> End Sub
>
> Private Sub Form_Load()
> Dim MyDB As Database
> Dim tdfLoop As TableDef
>
> Set MyDB = CurrentDb
> cbxDatabaseTable.RowSourceType = "Value List"
> For Each tdfLoop In MyDB.TableDefs
> If Left(tdfLoop.Name, 4) <> "MSys" Then
> If Nz(cbxDatabaseTable.RowSource, "") = "" Then
> cbxDatabaseTable.RowSource = tdfLoop.Name
> Else
> cbxDatabaseTable.RowSource = cbxDatabaseTable.RowSource _
> & ";" & tdfLoop.Name
> End If
> End If
> Next
> Set MyDB = Nothing
> End Sub
> '-------End Form Code
>
> '-------Module Code
> Option Compare Database
> Option Explicit
>
> Public Sub FixAutoNumber(strOriginal As String, strNew As String, _
> strIDFieldName As String, strBackupIDFieldName As String)
> Dim MyDB As Database
> Dim AutoRS As Recordset
> Dim NewRS As Recordset
> Dim strSQL As String
> Dim tdfAuto As TableDef
> Dim fldAuto As Field
> Dim lngCount As Long
> Dim lngI As Long
> Dim lngKey As Long
> Dim tdf As TableDef
> Dim fld As Field
> Dim idxAuto As Index
> Dim idx As Index
> Dim boolFound As Boolean
>
> 'Place contents of table called strOriginal into table called
> 'strNew whenever the new autonumber matches BackupID
> Set MyDB = CurrentDb
> 'Make sure index names and fields match
> For Each idxAuto In MyDB.TableDefs(strOriginal).Indexes
> If idxAuto.Name <> "PrimaryKey" Then
> boolFound = False
> For Each fld In idxAuto.Fields
> If idxAuto.Name = fld.Name Then
> boolFound = True
> Exit For
> End If
> Next fld
> If boolFound = False Then
> MsgBox ("An index name doesn't match a field name.")
> Set MyDB = Nothing
> Exit Sub
> End If
> End If
> Next idxAuto
> 'Delete the new table if it already exists
> For Each tdf In MyDB.TableDefs
> If tdf.Name = strNew Then
> MyDB.Execute "DROP TABLE " & strNew & ";"
> Exit For
> End If
> Next tdf
> Set tdf = MyDB.CreateTableDef(strNew)
> Set tdfAuto = MyDB.TableDefs(strOriginal)
> For Each fldAuto In tdfAuto.Fields
> If fldAuto.Type = dbText Then
> Set fld = tdf.CreateField(fldAuto.Name, dbText, fldAuto.Size)
> Else
> Set fld = tdf.CreateField(fldAuto.Name, fldAuto.Type)
> fld.Attributes = fldAuto.Attributes
> End If
> tdf.Fields.Append fld
> Next fldAuto
> MyDB.TableDefs.Append tdf
> tdf.Fields.Refresh
> For Each idxAuto In MyDB.TableDefs(strOriginal).Indexes
> If idxAuto.Name <> "PrimaryKey" Then
> Set idx = tdf.CreateIndex(idxAuto.Name)
> If idxAuto.Name = strIDFieldName Then idx.Primary = True
> If idxAuto.Required Then idx.Required = True
> idx.Fields.Append idx.CreateField(idxAuto.Name)
> tdf.Indexes.Append idx
> End If
> Next idxAuto
> tdf.Indexes.Refresh
> DoEvents
> strSQL = "SELECT * FROM " & strOriginal & " ORDER BY " _
> & strBackupIDFieldName & ";"
> Set AutoRS = MyDB.OpenRecordset(strSQL, dbOpenSnapshot)
> strSQL = "SELECT * FROM " & strNew & ";"
> Set NewRS = MyDB.OpenRecordset(strSQL, dbOpenDynaset)
> If AutoRS.RecordCount > 0 Then
> AutoRS.MoveLast
> lngCount = AutoRS.RecordCount
> AutoRS.MoveFirst
> For lngI = 1 To lngCount
> lngKey = 0
> Do Until lngKey = AutoRS(strBackupIDFieldName)
> NewRS.AddNew
> DoEvents
> lngKey = NewRS(strIDFieldName)
> Loop
> For Each fldAuto In tdfAuto.Fields
> If fldAuto.Name <> strIDFieldName Then
> NewRS(fldAuto.Name) = AutoRS(fldAuto.Name)
> End If
> Next fldAuto
> NewRS.Update
> If lngI <> lngCount Then AutoRS.MoveNext
> Next lngI
> End If
> AutoRS.Close
> Set AutoRS = Nothing
> NewRS.Close
> Set NewRS = Nothing
> Set MyDB = Nothing
> End Sub
> '-------End Module Code
>
> James A. Fortune
>[/color]
| 
