![]() | |
![]() |
| | Thread Tools | Display Modes |
#1
| |||
| |||
|
|
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 |
#2
| |||
| |||
|
|
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... |
#3
| |||
| |||
|
|
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 |
#4
| |||
| |||
|
|
In A97 you can APPEND a record to an autonumber table/field, to put any unused value into the field. In later versions you can ALSO change the table permissions to allow you to edit autonumbers. In both A97 and later versions you can APPEND a value to an autonumber table/field in SQL Server, but it is a two-step process in A97: later versions have /different/ problems with SQL Server. (david) |
#5
| |||
| |||
|
|
Access numerical data to pdf histogram: http://www.oakland.edu/~fortune/Histogram.zip |
#6
| |||
| |||
|
|
"Tony D'Ambra" <tdambra (AT) swiftdsl (DOT) com.au> wrote: 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... Eh? I've been using autonumber primary keys in all my systems since the first one I created in A2.0 using natural keys. Thus the autonumber keys are present in all the joins. Or am I misunderstanding something? Tony -- Tony Toews, Microsoft Access MVP Please respond only in the newsgroups so that others can read the entire thread of messages. Microsoft Access Links, Hints, Tips & Accounting Systems at http://www.granite.ab.ca/accsmstr.htm |
#7
| ||||
| ||||
|
|
Firstly, I find your use of "Eh?" offensive. Your MVP status does not exempt you from the rules of simple courtesy... |
|
By hard-coded joins I mean joins made using a custom ID field: look at the sample Northwinds .mdb join: Cutomers-Orders, which uses a custom ID field, CustomerID, which is not an autonumber field. |
|
Also, the following article excerpt is relevant: Teach your Access users to be wary of AutoNumbered primary keys |
|
The negative side is that the application stands a much better chance of failing if the AutoNumbered values become corrupt. |
#8
| |||
| |||
|
|
"Tony D'Ambra" <tdambra (AT) swiftdsl (DOT) com.au> wrote: The negative side is that the application stands a much better chance of failing if the AutoNumbered values become corrupt. This was a problem in some versions of Jet 4.0 but SPs fixed those. While I still mostly work in A97 I've never had a problem with Autonumber values becoming corrupt. |
#9
| |||
| |||
|
|
Tony Toews wrote: "Tony D'Ambra" <tdambra (AT) swiftdsl (DOT) com.au> wrote: The negative side is that the application stands a much better chance of failing if the AutoNumbered values become corrupt. This was a problem in some versions of Jet 4.0 but SPs fixed those. While I still mostly work in A97 I've never had a problem with Autonumber values becoming corrupt. What are the symptoms of a corrupt autonumber field? Do the values already stored mysteriously change or are duplicates suddenly allowed in a primary key field? Or something else? |
#10
| |||
| |||
|
|
Tony Toews wrote: "Tony D'Ambra" <tdambra (AT) swiftdsl (DOT) com.au> wrote: The negative side is that the application stands a much better chance of failing if the AutoNumbered values become corrupt. This was a problem in some versions of Jet 4.0 but SPs fixed those. While I still mostly work in A97 I've never had a problem with Autonumber values becoming corrupt. What are the symptoms of a corrupt autonumber field? Do the values already stored mysteriously change or are duplicates suddenly allowed in a primary key field? Or something else? |
![]() |
| Thread Tools | |
| Display Modes | |
| |