Access VBAで自動連番を振るには

質問

Access2000で株主管理DBを作成中です。
【テーブル名】T_株券管理
【フォーム名】F_株主入力
【フィールド名】株主ID（テキスト型）（主キー）
フォームに入力する際にオートナンバーを使用せずに、
レコードが切り替わると「株主ID」が「00001」「00002」「00003」・・・・というように1づつ発番されるようにしたく、AccessVBAの本を読んだり、ネットでDmax等調べているのですが、必要な情報が探せずに困っています。お手数ですが教えて頂けますでしょうか。よろしくお願い致します。

回答No.1

noname#140971

<id管理表>

id_name______final_value
employee_____0
perform_id___12
仕入先_id____10

こういう、いわゆる<採番テーブル>を用意するのも一つの方法です。
最大値を取得して＋１するよりも、ネットワークの負担は軽いからです。

Private Sub 仕入先名_BeforeUpdate(Cancel AS Integer)
　　 Dim strShiiresaki AS String
　　 Dim strWhere　　　AS String

　　 strShiiresaki = Nz(Me.仕入先名, "")
　　 strWhere = "仕入先名='" & strShiiresaki & "' AND id<>" & Me.ID
　　 Cancel = CBool(DBLookup("id", "仕入先", strWhere, 0) <> 0)
　　 If Cancel Then
　　　　 Message "[仕入先名]が重複しています。" & chr$(13) & chr$(13) & _
　　　　　　　　 "・{Esc}{Esc} で入力を取り消すことができます。"
　　 ElseIf isNewRecord And Me.ID = 0 Then
　　　　 Me.ID = NewID("仕入先_id")
　　　　 SetFieldEnabled Me, True
　　 End IF
End Sub

これは、仕入先マスターの[ID]を実際に取得しているコードです。
ここでは、NewID() を使用しています。

NewID()は、最終の番号に＋１して<id管理表>を更新すると共にその値を戻しています。

取得するための SQL 文を埋め込んでいますが、準システム関数みたいなものだから構いません。
ｒｓｔ、cnn の破棄コードは不可欠ではありませんので抜いてもいいです。
一応、エラートラップも仕組んでいますが、これが働く場面はないでしょう。
いわば、おまじないみたいなものです。

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

お礼

ご回答ありがとうございます。
難しすぎて理解できませんでした。
VB初心者なので、もう少し勉強してみます。