自动编号重新生成 [英] AutoNumber Regeneration
问题描述
有时我会将自动编号字段用于ID字段。此外，
有时我会在orderdetail类型表中使用相同的字段。因此，在这种情况下，重要的是，一旦将自动编号键值分配给
一条记录，它就不会改变。偶尔我发现由于
损坏或意外删除和恢复来自
备份的记录，自动编号字段需要整理。因此，当我创建
（通过AddNew）用于连接的自动编号键时，我还在备份ID字段（Long）中保存了一个
副本。我总是可以使用
备份ID进行连接，但我不喜欢备份ID与自动编号值不同的
。我决定我真的想要
重新生成自动编号字段以匹配备份ID值。我从
无法获得自动编号字段上的'强制更新到以前
已删除的值''想法从最近的帖子开始工作所以我创建了一些代码
来做。它仍然有点粗糙，但可能足以让某人
指出一种更简单的方法。代码在A97中。我没有任何RI
来处理。表单显示数据库中的表格，一旦选择了
表格，这些字段将填充两个组合框，用于选择
主键字段和备份ID字段。 txtNewTableName用于具有已修复的自动编号值的新表的
名称。主要的
想法是在没有更新的情况下使用AddNew，直到下一个备份ID达到
。
'' - -----表格代码
选项比较数据库
选项明确
私有子cbxDatabaseTable_AfterUpdate（）
Dim MyDB As Database
Dim tdf As TableDef
Dim fld As Field
If IsNull（cbxDatabaseTable.Value）然后
cbxIDFieldName.RowSource =""
cbxBackupIDFieldName.RowSource =""
cbxIDFieldName.Value = Null
cbxBackupIDFieldName.Value = Null
退出Sub
结束如果
''将字段名称放在cbxIDFieldName和cbxBackupIDFieldName
设置MyDB = CurrentDb
cbxIDFieldName.RowSourceType ="值列表"
cbxBackupIDFieldName.RowSourceType ="值列表"
对于每个fld在MyDB.TableDefs（cbxDatabaseTable.Value）.Fields
如果是Nz（cbxIDFieldNa me.RowSource，""）=""那么
cbxIDFieldName.RowSource = fld.Name
否则
cbxIDFieldName.RowSource = cbxIDFieldName.RowSource _
& ;英寸;" &安培; fld.Name
结束如果
如果Nz（cbxBackupIDFieldName.RowSource，""）=""然后
cbxBackupIDFieldName.RowSource = fld.Name
否则
cbxBackupIDFieldName.RowSource = cbxBackupIDFieldName.RowSource _
& ;英寸;" &安培; fld.Name
结束如果
下一个fld
设置MyDB = Nothing
End Sub
< br $>
私有子cmdFixAutonumber_Click（）
如果IsNull（cbxDatabaseTable.Value）那么
MsgBox（没有选择表格。）
退出Sub
结束如果
如果IsNull（txtNewTableName.Value）那么
MsgBox（没有新的表名称被选中。）
退出Sub
结束如果
如果是IsNull（cbxIDFieldName.Value）那么
MsgBox（未选择ID字段。）
退出子
结束如果
如果IsNull（cbxBackupIDFieldName.Value）则
MsgBox（未选择备份ID字段。）
退出子页
结束如果
致电FixAutoNumber（cbxDatabaseTable.Value，txtNewTableName.Value，_
cbxIDFieldName.Value，cbxBackupIDFieldName.Value）
MsgBox（完成。）
End Sub
Private Sub Form_Load（）
Dim MyDB作为数据库
Dim tdfLoop As TableDef
设置MyDB = CurrentDb
cbxDatabaseTable.RowSourceType =" Value List"
每个tdfLoop在MyDB.TableDefs中
如果为Left（tdfLoop.Name，4）<> "&MSys的QUOT;然后
如果Nz（cbxDatabaseTable.RowSource，""）=""那么
cbxDatabaseTable.RowSource = tdfLoop.Name
否则
cbxDatabaseTable.RowSource = cbxDatabaseTable.RowSource _
& ;英寸;" &安培; tdfLoop.Name
结束如果
结束如果
下一页
设置MyDB = Nothing
End Sub
''-------结束表格代码
''-------模块代码
选项比较数据库
选项明确
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
''将名为strOriginal的表的内容放入表中
''strNew每当新的autonumber matche ■BackupID
设置MyDB = CurrentDb
''确保索引名称和字段匹配
For Each idxAuto in MyDB.TableDefs（strOriginal）。索引
如果idxAuto.Name<> "&的PrimaryKey QUOT;然后
boolFound = False
每个fld在idxAuto.Fields
如果idxAuto.Name = fld.Name那么
boolFound = True
退出
结束如果
下一个fld
如果boolFound = False那么
MsgBox（索引名称与字段名称不匹配。）
设置MyDB = Nothing
退出子
结束如果
结束如果
下一个idxAuto
''删除新表（如果已存在）
对于MyDB.TableDefs中的每个tdf
如果tdf.Name = strNew则
MyDB.Execute" DROP TABLE" &安培; strNew& ""
退出
结束如果
下一个tdf
设置tdf = MyDB.CreateTableDef（ strNew）
设置tdfAuto = MyDB.TableDefs（strOriginal）
每个fldAuto在tdfAuto.Fields中
如果fldAuto.Type = dbText那么
设置fld = tdf.CreateField（fldAuto.Name，dbText，fldAuto.Size）
否则
设置fld = tdf.CreateField（fldAuto。姓名，fldAuto.Type）
fld.Attributes = fldAuto.Attributes
结束如果
tdf.Fields.Append fld
下一个fldAuto
MyDB.TableDefs.Append tdf
tdf.Fields.Refresh
每个idxAuto在MyDB.TableDefs（strOriginal） .Indexes
如果idxAuto.Name<> "&的PrimaryKey QUOT;然后
设置idx = tdf.CreateIndex（idxAuto.Name）
如果idxAuto.Name = strIDFieldName那么idx.Primary = True
如果idxAuto .Required然后idx.Required = True
idx.Fields.Append idx.CreateField（idxAuto.Name）
tdf.Indexes.Append idx
结束如果
下一个idxAuto
tdf.Indexes.Refresh
DoEvents
strSQL =" SELECT * FROM " &安培; strOriginal& " ORDER BY _
& strBackupIDFieldName& ""
设置AutoRS = MyDB.OpenRecordset（strSQL，dbOpenSnapshot）
strSQL =" SELECT * FROM" &安培; strNew& ""
设置NewRS = MyDB.OpenRecordset（strSQL，dbOpenDynaset）
如果AutoRS.RecordCount> 0然后
AutoRS.MoveLast
lngCount = AutoRS.RecordCount
AutoRS.MoveFirst
对于lngI = 1 To lngCount
lngKey = 0
Do until lngKey = AutoRS（strBackupIDFieldName）
NewRS.AddNew
DoEvents
lngKey = NewRS（strIDFieldName）
循环
每个fldAuto in tdfAuto.Fields
如果fldAuto.Name< > strIDFieldName然后
NewRS（fldAuto.Name）= AutoRS（fldAuto.Name）
结束如果
下一个fldAuto
NewRS.Update
如果lngI<> lngCount然后AutoRS.MoveNext
下一个lngI
结束如果
AutoRS.Close
设置AutoRS = Nothing
NewRS.Close
Set NewRS = Nothing
设置MyDB = Nothing
End Sub
''-------结束模块代码
James A. Fortune
在连接中使用自动编号键的问题是有问题的，原因是
概述。您应该使用硬编码的ID来加入以避免问题
...
Tony D''Ambra
网站： aadconsulting.com
网络博客：accessextra.net
< ji ******** @ compumarc.com>在消息中写道
新闻：11 ********************* @ c13g2000cwb.googlegro ups.com ...有时我将自动编号字段用于ID字段。此外，有时我在orderdetail类型表中使用相同的字段。因此，在这种情况下重要的是，一旦将自动编号键值分配给
一条记录，它就不会改变。偶尔我发现由于
损坏或意外删除和恢复备份中的记录，需要整理自动编号字段。因此，当我创建
（通过AddNew）用于连接的自动编号键时，我还将一个
副本保存在备份ID字段（Long）中。我总是可以使用
备份ID进行连接，但我不希望备份ID与自动编号值不同。我决定我真的想重新生成自动编号字段以匹配备份ID值。我无法从最近发布的帖子中获取自动编号字段上的'强制更新到先前已删除的值'的想法，因此我创建了一些代码来完成它。它仍然有点粗糙，但可能足以让某人指出一种更简单的方法。代码在A97中。我没有任何RI要处理。表单显示数据库中的表格，一旦选择了表格，字段就会填充两个组合框，用于选择主键字段和备份ID字段。 txtNewTableName用于具有已修复的自动编号值的新表的
名称。主要的想法是在没有更新的情况下使用AddNew，直到达到下一个备份ID。
''-------表格代码
选项比较数据库
选项明确
私有子cbxDatabaseTable_AfterUpdate（）
将MyDB作为数据库昏暗
Dim tdf As TableDef
Dim fld As Field
如果IsNull（cbxDatabaseTable.Value）那么
cbxIDFieldName.RowSource =""
cbxBackupIDFieldName.RowSource =""
cbxIDFieldName.Value = Null
cbxBackupIDFieldName。值= Null
退出Sub
结束如果
''将字段名称放在cbxIDFieldName和cbxBackupIDFieldName中
设置MyDB = CurrentDb
cbxIDFieldName.RowSourceType =" Value List"
cbxBackupIDFieldName.RowSourceType =" Value List"
对于每个fld在MyDB.TableDefs（cbxDatabaseTable.Value）.Fields
如果Nz（cbxIDFieldName.RowSource，""）=" "那么
cbxIDFieldName.RowSource = fld.Name
否则
cbxIDFieldName.RowSource = cbxIDFieldName.RowSource _
&英寸;" &安培; fld.Name
结束如果
如果Nz（cbxBackupIDFieldName.RowSource，""）=""然后
cbxBackupIDFieldName.RowSource = fld.Name
其他
cbxBackupIDFieldName.RowSource = cbxBackupIDFieldName.RowSource _
&英寸;" &安培; fld.Name
结束如果
下一个fld
设置MyDB = Nothing
End Sub
私有子cmdFixAutonumber_Click（）
如果IsNull（cbxDatabaseTable） .Value）然后
MsgBox（没有选择表格。）
退出Sub
结束如果
如果IsNull（txtNewTableName.Value）那么
MsgBox（ 没有选择新的表名。
退出Sub
结束如果
如果IsNull（cbxIDFieldName.Value）那么
MsgBox（No ID Field被选中。 ）退出Sub
结束如果
如果IsNull（cbxBackupIDFieldName.Value）那么
MsgBox（未选择备份ID字段。）
退出Sub
结束如果
调用FixAutoNumber（cbxDatabaseTable.Value，txtNewTableName.Value，_
cbxIDFieldName.Value，cbxBackupIDFieldName.Value）
MsgBox（" Done。"）
结束Sub
私有Sub Form_Load（）
Dim MyDB作为数据库
Dim tdfLoop As TableDef
设置MyDB = CurrentDb
cbxDatabaseTable .RowSourceType ="值列表&q uot;
对于MyDB.TableDefs中的每个tdfLoop
如果Left（tdfLoop.Name，4）<> "&MSys的QUOT;然后
如果Nz（cbxDatabaseTable.RowSource，""）=""然后
cbxDatabaseTable.RowSource = tdfLoop.Name
其他
cbxDatabaseTable.RowSource = cbxDatabaseTable.RowSource _
&英寸;" &安培; tdfLoop.Name
结束如果
结束如果
下一页
设置MyDB = Nothing
结束子
''-------结束表格代码
'-------模块代码
选项比较数据库
选项显式
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
''将名为strOriginal的表的内容放入名为
的表中''每当新的自动编号与BackupID匹配时strNew
设置MyDB = CurrentDb
''确保索引名称和字段匹配
对于MyDB.TableDefs中的每个idxAuto（strOrigi） nal）.Indexes
如果idxAuto.Name<> "&的PrimaryKey QUOT;然后
boolFound = False
对于每个fld在idxAuto.Fields
如果idxAuto.Name = fld.Name那么
boolFound = True
退出
结束如果
下一个fld
如果boolFound = False那么
MsgBox（索引名称与字段名称不匹配。）
设置MyDB = Nothing
退出Sub
结束如果
结束如果
下一个idxAuto
''删除新表（如果已存在）
对于每个tdf在MyDB.TableDefs
如果tdf.Name = strNew那么
MyDB.Execute" DROP TABLE" &安培; strNew& ""
退出
结束如果
下一个tdf
设置tdf = MyDB.CreateTableDef（strNew）
设置tdfAuto = MyDB.TableDefs（strOriginal）
对于每个fldAuto在tdfAuto.Fields
如果fldAuto.Type = dbText然后
设置fld = tdf.CreateField（fldAuto.Name，dbText，fldAuto.Size）
其他设置fld = tdf.CreateField（fldAuto.Name，fldAuto.Type）
fld.Attributes = fldAuto.Attributes
结束如果
tdf.Fields.Append fld
下一个fldAuto
MyDB.TableDefs.Append tdf
tdf.Fields.Refresh
对于每个idxAuto在MyDB.TableDefs（strOriginal）.Indexes
如果idxAuto.Name<> "&的PrimaryKey QUOT;然后
设置idx = tdf.CreateIndex（idxAuto.Name）
如果idxAuto.Name = strIDFieldName那么idx.Primary = True
如果idxAuto.Required那么idx.Required = True
idx.Fields.Append idx.CreateField（idxAuto.Name）
tdf.Indexes.Append idx
结束如果
下一个idxAuto
tdf.Indexes.Refresh
DoEvents
strSQL =" SELECT * FROM" &安培; strOriginal& " ORDER BY _
& strBackupIDFieldName& " ;;"
设置AutoRS = MyDB.OpenRecordset（strSQL，dbOpenSnapshot）
strSQL =" SELECT * FROM" &安培; strNew& " ;;"
设置NewRS = MyDB.OpenRecordset（strSQL，dbOpenDynaset）
如果AutoRS.RecordCount> 0然后
AutoRS.MoveLast
lngCount = AutoRS.RecordCount
AutoRS.MoveFirst
对于lngI = 1到lngCount
lngKey = 0
Do until lngKey = AutoRS（strBackupIDFieldName）
NewRS.AddNew
DoEvents
lngKey = NewRS（strIDFieldName）
循环
每个fldAuto在tdfAuto.Fields
如果fldAuto.Name <> strIDFieldName然后
NewRS（fldAuto.Name）= AutoRS（fldAuto.Name）
结束如果
下一个fldAuto
NewRS.Update
如果lngI<> lngCount然后AutoRS.MoveNext
下一个lngI
结束如果
AutoRS.Close
设置AutoRS = Nothing
NewRS.Close
设置NewRS = Nothing
设置MyDB = Nothing
End Sub
''-------结束模块代码
James A. Fortune
" Tony D''Ambra" < TD ***** @ swiftdsl.com.au>写道：
由于概述的原因，在连接中使用自动编号键的问题是有问题的。你应该使用硬编码的id'来加入以避免这个问题
...
Eh？自从第一个使用自然键在A2.0中创建的
以来，我一直在我的所有系统中使用自动编号主键。因此，自动编号键存在于所有
连接中。或者我误解了什么？
Tony
-
Tony Toews，Microsoft Access MVP
请仅在新闻组中回复，以便其他人可以阅读整个邮件主题。
Microsoft Access Links，Hints，Tips&会计系统
http://www.granite.ab.ca /accsmstr.htm
在A97中，您可以将记录附加到自动编号表/字段，
以放置任何未使用的值进入现场。
在以后的版本中，您还可以更改表格权限
以允许您编辑自动编号。
在A97和更高版本中，你可以在SQL Server中附加一个值为
的自动编号表/字段，但它在A97中是一个两步的
过程：更高版本有/不同/问题
与SQL Server。
（大卫）
< ji ********@compumarc.com>在消息中写道
新闻：11 ********************* @ c13g2000cwb.googlegro ups.com ...有时我将自动编号字段用于ID字段。此外，有时我在orderdetail类型表中使用相同的字段。因此，在这种情况下重要的是，一旦将自动编号键值分配给
一条记录，它就不会改变。偶尔我发现由于
损坏或意外删除和恢复备份中的记录，需要整理自动编号字段。因此，当我创建
（通过AddNew）用于连接的自动编号键时，我还将一个
副本保存在备份ID字段（Long）中。我总是可以使用
备份ID进行连接，但我不希望备份ID与自动编号值不同。我决定我真的想重新生成自动编号字段以匹配备份ID值。我无法从最近发布的帖子中获取自动编号字段上的'强制更新到先前已删除的值'的想法，因此我创建了一些代码来完成它。它仍然有点粗糙，但可能足以让某人指出一种更简单的方法。代码在A97中。我没有任何RI要处理。表单显示数据库中的表格，一旦选择了表格，字段就会填充两个组合框，用于选择主键字段和备份ID字段。 txtNewTableName用于具有已修复的自动编号值的新表的
名称。主要的想法是在没有更新的情况下使用AddNew，直到达到下一个备份ID。
''-------表格代码
选项比较数据库
选项明确
私有子cbxDatabaseTable_AfterUpdate（）
将MyDB作为数据库昏暗
Dim tdf As TableDef
Dim fld As Field
如果IsNull（cbxDatabaseTable.Value）那么
cbxIDFieldName.RowSource =""
cbxBackupIDFieldName.RowSource =""
cbxIDFieldName.Value = Null
cbxBackupIDFieldName。值= Null
退出Sub
结束如果
''将字段名称放在cbxIDFieldName和cbxBackupIDFieldName中
设置MyDB = CurrentDb
cbxIDFieldName.RowSourceType =" Value List"
cbxBackupIDFieldName.RowSourceType =" Value List"
对于每个fld在MyDB.TableDefs（cbxDatabaseTable.Value）.Fields
如果Nz（cbxIDFieldName.RowSource，""）=" "那么
cbxIDFieldName.RowSource = fld.Name
否则
cbxIDFieldName.RowSource = cbxIDFieldName.RowSource _
&英寸;" &安培; fld.Name
结束如果
如果Nz（cbxBackupIDFieldName.RowSource，""）=""然后
cbxBackupIDFieldName.RowSource = fld.Name
其他
cbxBackupIDFieldName.RowSource = cbxBackupIDFieldName.RowSource _
&英寸;" &安培; fld.Name
结束如果
下一个fld
设置MyDB = Nothing
End Sub
私有子cmdFixAutonumber_Click（）
如果IsNull（cbxDatabaseTable） .Value）然后
MsgBox（没有选择表格。）
退出Sub
结束如果
如果IsNull（txtNewTableName.Value）那么
MsgBox（ 没有选择新的表名。
退出Sub
结束如果
如果IsNull（cbxIDFieldName.Value）那么
MsgBox（No ID Field被选中。 ）退出Sub
结束如果
如果IsNull（cbxBackupIDFieldName.Value）那么
MsgBox（未选择备份ID字段。）
退出Sub
结束如果
调用FixAutoNumber（cbxDatabaseTable.Value，txtNewTableName.Value，_
cbxIDFieldName.Value，cbxBackupIDFieldName.Value）
MsgBox（" Done。"）
结束Sub
私有Sub Form_Load（）
Dim MyDB作为数据库
Dim tdfLoop As TableDef
设置MyDB = CurrentDb
cbxDatabaseTable .RowSourceType ="值列表&q uot;
对于MyDB.TableDefs中的每个tdfLoop
如果Left（tdfLoop.Name，4）<> "&MSys的QUOT;然后
如果Nz（cbxDatabaseTable.RowSource，""）=""然后
cbxDatabaseTable.RowSource = tdfLoop.Name
其他
cbxDatabaseTable.RowSource = cbxDatabaseTable.RowSource _
&英寸;" &安培; tdfLoop.Name
结束如果
结束如果
下一页
设置MyDB = Nothing
结束子
''-------结束表格代码
'-------模块代码
选项比较数据库
选项显式
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
''将名为strOriginal的表的内容放入名为
的表中''每当新的自动编号与BackupID匹配时strNew
设置MyDB = CurrentDb
''确保索引名称和字段匹配
对于MyDB.TableDefs中的每个idxAuto（strOrigi） nal）.Indexes
如果idxAuto.Name<> "&的PrimaryKey QUOT;然后
boolFound = False
对于每个fld在idxAuto.Fields
如果idxAuto.Name = fld.Name那么
boolFound = True
退出
结束如果
下一个fld
如果boolFound = False那么
MsgBox（索引名称与字段名称不匹配。）
设置MyDB = Nothing
退出Sub
结束如果
结束如果
下一个idxAuto
''删除新表（如果已存在）
对于每个tdf在MyDB.TableDefs
如果tdf.Name = strNew那么
MyDB.Execute" DROP TABLE" &安培; strNew& ""
退出
结束如果
下一个tdf
设置tdf = MyDB.CreateTableDef（strNew）
设置tdfAuto = MyDB.TableDefs（strOriginal）
对于每个fldAuto在tdfAuto.Fields
如果fldAuto.Type = dbText然后
设置fld = tdf.CreateField（fldAuto.Name，dbText，fldAuto.Size）
其他设置fld = tdf.CreateField（fldAuto.Name，fldAuto.Type）
fld.Attributes = fldAuto.Attributes
结束如果
tdf.Fields.Append fld
下一个fldAuto
MyDB.TableDefs.Append tdf
tdf.Fields.Refresh
对于每个idxAuto在MyDB.TableDefs（strOriginal）.Indexes
如果idxAuto.Name<> "&的PrimaryKey QUOT;然后
设置idx = tdf.CreateIndex（idxAuto.Name）
如果idxAuto.Name = strIDFieldName那么idx.Primary = True
如果idxAuto.Required那么idx.Required = True
idx.Fields.Append idx.CreateField（idxAuto.Name）
tdf.Indexes.Append idx
结束如果
下一个idxAuto
tdf.Indexes.Refresh
DoEvents
strSQL =" SELECT * FROM" &安培; strOriginal& " ORDER BY _
& strBackupIDFieldName& " ;;"
设置AutoRS = MyDB.OpenRecordset（strSQL，dbOpenSnapshot）
strSQL =" SELECT * FROM" &安培; strNew& " ;;"
设置NewRS = MyDB.OpenRecordset（strSQL，dbOpenDynaset）
如果AutoRS.RecordCount> 0然后
AutoRS.MoveLast
lngCount = AutoRS.RecordCount
AutoRS.MoveFirst
对于lngI = 1到lngCount
lngKey = 0
Do until lngKey = AutoRS（strBackupIDFieldName）
NewRS.AddNew
DoEvents
lngKey = NewRS（strIDFieldName）
循环
每个fldAuto在tdfAuto.Fields
如果fldAuto.Name <> strIDFieldName然后
NewRS（fldAuto.Name）= AutoRS（fldAuto.Name）
结束如果
下一个fldAuto
NewRS.Update
如果lngI<> lngCount然后AutoRS.MoveNext
下一个lngI
结束如果
AutoRS.Close
设置AutoRS = Nothing
NewRS.Close
设置NewRS = Nothing
设置MyDB = Nothing
End Sub
''-------结束模块代码
James A. Fortune
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
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
<ji********@compumarc.com> wrote in message
news:11*********************@c13g2000cwb.googlegro ups.com...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
"Tony D''Ambra" <td*****@swiftdsl.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
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)
<ji********@compumarc.com> wrote in message
news:11*********************@c13g2000cwb.googlegro ups.com...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
这篇关于自动编号重新生成的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
