アクセスのMoveLastの使い方について

質問

初めてアクセスでツールを作っています。
リストを登録するツールを作っており、フォームに入れた情報を
「テーブル」に登録する仕様となっております。
フォームを開く際、自動的にIDのフォームにID番号を採番したいです。
ID番号はリストを登録する「テーブル」を参照し、既存のレコードの最後の行を検索し
最後の行に＋１をした番号を振るようにしました。
下記のようにプログラムを組み、最初のID：１、２、３まではフォームを開いた際に自動的に採番できました。
ところが次の4番目のデータを登録する際にフォームを開くと
何故かIDは３のまま表示されてしまいます。
デバックしたところ、Debug.Print rs!ID　の箇所は何故か数字が２が入っております。
MoveLast でレコード末尾を参照しようとしているのですが、
何故か末尾であるはずの３にはなりません。
アクセスでこのようなツールを作るのは初めてになるため、原因がわかる方お願い致します。

Private Sub Form_Load()
'フォーム読み込み時にID番号を付与
Dim rs As New ADODB.Recordset
Me.ID.Value = Null
rs.Open "テーブル", CurrentProject.Connection

If rs.EOF = True Then
Me.ID.Value = 1
Else
rs.MoveLast
Debug.Print rs!ID
Me.ID.Value = rs!ID.Value + 1
End If
rs.Close

End Sub

回答No.1

山田 太郎（@f_a_007） · ベストアンサー

１、一般的な採番手法。

私は、テーブル「主キー管理表」や「id管理表」等を用意して管理するんだろうと認識しています。

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

２、安直な採番手法。

それは、テーブルの最後のレコードの列[id]の値ではなく最大値を求める手法。もちろん、列[id]で逆順に ORDER BY して先頭のレコードを参照する手もあります。しかし、安直な普通のやり方は最大値を求める手法です。

Public Function DBLookup(ByVal strQuerySQL As String, _
　　　　　　　　　　　　　Optional ByVal ReturnValue = Null) As Variant
On Error GoTo Err_DBLookup
　　Dim DataValue
　　Dim rst　　　　 As ADODB.Recordset

　　Set rst = New ADODB.Recordset
　　With rst
　　　　.Open strQuerySQL, _
　　　　　　　CurrentProject.Connection, _
　　　　　　　adOpenStatic, _
　　　　　　　adLockReadOnly
　　　　If Not .BOF Then
　　　　　　.MoveFirst
　　　　　　DataValue = .Fields(0)
　　　　End If
　　End With
Exit_DBLookup:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBLookup = IIf(Len(DataValue & ""), DataValue, ReturnValue)
　　Exit Function
Err_DBLookup:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBLookup)" & Chr$(13) & Chr$(13) & _
　　　　　 "・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　 "・SQL Text=" & strQuerySQL, _
　　　　　 vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBLookup
End Function

（注意）テーブルの並びは、必ずしも登録順、あるいは主キー昇順ではない。その状況は、変化する。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
　PS、主キーの追加、参照とCnnExecute()
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

? CnnExecute("INSERT INTO id管理表 VALUES ('Test2', 2);")
True
? DBLookup("final_value", "id管理表", "id_name='Test2'")
2
? CnnExecute("INSERT INTO id管理表 (id_name, final_value) VALUES ('Test3', 3);")
True
? DBLookup("final_value", "id管理表", "id_name='Test3'")
3
? CnnExecute("DELETE FROM id管理表 WHERE id_name='Test2';")
True
? DBLookup("final_value", "id管理表", "id_name='Test2'")
NULL
? CnnExecute("DELETE FROM id管理表 WHERE final_value=3;")
True
? DBLookup("final_value", "id管理表", "id_name='Test3'")
NULL

このように私はSQL文を実行する関数（CnnExecute、）でもって主キーの参照、追加を行っていました。

Public Function CnnExecute(ByVal strSQL As String) As Boolean
On Error Goto Err_CnnExecute
　　Dim isOK As Boolean
　　Dim cnn　As ADODB.Connection

　　isOK = True
　　Set cnn = CurrentProject.Connection
　　With cnn
　　　　.Errors.Clear
　　　　.BeginTrans
　　　　.Execute strSQL
　　　　.CommitTrans
　　End With
Exit_CnnExecute:
On Error Resume Next
　　cnn.close
　　Set cnn = Nothing
　　CnnExecute = isOK
　　Exit Function
Err_CnnExecute:
　　isOK = False
　　If cnn.Errors.Count > 0 Then
　　　　ErrMessage cnn.Errors(0), strSQL
　　　　cnn.Rollbacktrans
　　Else
　　　　MsgBox "プログラムエラーが発生しました。" & _
　　　　　　　 "システム管理者に報告して下さい。(CnnExecute)", _
　　　　　　　 vbExclamation, " 関数エラーメッセージ"
　　End If
　　Resume Exit_CnnExecute
End Function