【Access VBA】主キー値をSQL Serverから取得する


主キー値をSQL Serverから取り出す

AccessSQL Serverのテーブルに接続し、新規レコード保存の際、主キー値をSQL Serverで設定します。


SQL Serverにテーブルを準備する

SQL Serverで「sample」という名前のデータベースの中に「Tサンプル」という名前のテーブルと「T発番」という名前のテーブルを用意しました。


SQL Serverにストアドプロシージャを準備する

SQL Serverに「SetID」という名前のストアドプロシージャを用意しました。

ALTER PROCEDURE [dbo].[SetID]
	
	@ID int OUTPUT 
AS
BEGIN
	
	SET NOCOUNT ON;
    
	BEGIN TRY
		BEGIN TRANSACTION
			SELECT @ID=連番 FROM T発番
			UPDATE T発番 SET 連番=@ID+1
		COMMIT TRANSACTION 
		RETURN-1 
	END TRY

	BEGIN CATCH
		ROLLBACK TRANSACTION		
		RETURN 0
	END CATCH
END


フォームの準備

下のようなラベル3個、テキストボックス3個、ボタン1個を配置した非連結フォームを用意しました。


コードの記述

フォームの開く時と「更新」ボタンのクリック時に下記イベントプロシージャを記述しました。

Private cn As New ADODB.Connection
Private rs As New ADODB.Recordset
Private Sub Form_Open(Cancel As Integer)
'-----------SQL Serverの「sample」データベースに接続-----------------------
    Dim strCN As String
    strCN = "driver={ODBC Driver 17 for SQL Server};server=LAPTOP-114315\SQLEXPRESS;DATABASE=sample;uid=administrator;PWD=1111"
    cn.Open strCN
'------------------------------------------------------------------------------------
'-----------ストアドプロシージャからIDを取得---------------------------------
    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = cn
    cmd.CommandType = adCmdStoredProc
    cmd.CommandText = "SetID"
    cmd.Parameters.Append cmd.CreateParameter(, adInteger, adParamReturnValue, , Null)
    cmd.Parameters.Append cmd.CreateParameter("@ID", adInteger, adParamOutput, , Null)
    cmd.Execute
    
    If CBool(cmd.Parameters(0).Value) Then
        If IsNull(txtID) Then
            txtID = cmd.Parameters("@ID").Value
        End If
    Else
        MsgBox "IDの取得に失敗しました。", vbExclamation, "確認"
        cn.Close: Set cn = Nothing
        Cancel = True
    End If
'-----------------------------------------------------------------------------------
End Sub
Private Sub btnUpdate_Click()
    Dim strSQL As String
    strSQL = "SELECT * FROM Tサンプル WHERE ID=" & txtID
    rs.Open strSQL, cn, adOpenKeyset, adLockOptimistic

            rs.AddNew
            rs![ID] = txtID
            rs![日付] = txtDate
            rs![数量] = txtQuantity
            rs.Update

    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
    DoCmd.Close
End Sub


テスト

現在、「ID」が「130」までのデータが保存されているとします。

フォームを開くと「ID」テキストボックスに「131」が発番されます。

日付と数量を入力し「更新」ボタンをクリックするとテーブルにレコードが保存されます。