【id管理表】
id_name char(32) 主キー
final_value long
Private Sub Form_BeforeInsert(Cancel As Integer)
Me.ID = NewID("perform_id")
Cancel = CBool(Me.ID = -1)
If Cancel Then
StopMsg "ＩＤ番号が取得できませんでした。" & _
"システム管理者に報告して下さい。(Form_BeforeInsert)"
End If
End Sub
[id管理表]には、初期値が用意されていなければなりません。そうでないと、NewID関数は、-1を戻します。
初期値さえ設定して「おけば、NewID関数で、テーブル[Perform]の主キー列[ID]の値はシーケンシャルに発生させることが可。
私は、このような採番テーブル【id管理表】と値を取得し更新する関数NewID()を利用しています。
つまり、例でも判るようにテーブル[Perform]とは別に専用の採番テーブルを用意しているということです。
Public Function NewID(ByVal strIDName As String) As Long
On Error GoTo Err_NewID
Dim N As Long
Dim strSQL As String
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strSQL = "SELECT final_value FROM id管理表 WHERE id_name='" & strIDName & "'"
cnn.Errors.Clear
cnn.BeginTrans
With rst
.Open strSQL, _
cnn, _
adOpenDynamic, _
adLockOptimistic
If Not .BOF Then
N = .Fields(0) + 1
.Fields(0) = N
.Update
End If
End With
cnn.CommitTrans
Exit_NewID:
On Error Resume Next
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
NewID = N
Exit Function
Err_NewID:
N = -1
If cnn.Errors.Count > 0 Then
ErrMessage cnn.Errors(0), strSQL
cnn.RollbackTrans
Else
MsgBox "プログラムエラーが発生しました。システム管理者に報告して下さい。(NewID)", _
vbExclamation, " 関数エラーメッセージ"
End If
Resume Exit_NewID
End Function
Public Sub ErrMessage(ByVal CnnErrors As adodb.Error, ByVal strSQL As String)
MsgBox "ADOエラーが発生しましたので処理をキャンセルします。" & Chr$(13) & Chr$(13) & _
"・Err.Description=" & CnnErrors.Description & Chr$(13) & _
"・Err.Number=" & CnnErrors.Number & Chr$(13) & _
"・SQL State=" & CnnErrors.SQLState & Chr$(13) & _
"・SQL Text=" & strSQL, _
vbExclamation, " ADO関数エラーメッセージ"
End Sub
