【Access VBA】SQL Serverのテーブルを編集する - カットマンブログ

【Access VBA】SQL Serverのテーブルを編集する

Access VBA


AccessからSQL Serverのテーブルを編集する

SQL Serverの「売上伝票」テーブルおよび「売上明細」テーブルのデータをAccessで取得し、修正を加えたのち、SQL Serverに保存します。


テーブルを準備する

SQL Serverで「sample」という名前のデータベースの中に「T売上伝票」、「T売上明細」、「TEMP売上伝票」、「TEMP売上明細」の4つのテーブルを用意しました。「T売上伝票」、「T売上明細」は生データを保存するテーブルであり、「TEMP売上伝票」、「TEMP売上明細」は一時的にAccessから編集後のデータを受け取るテーブルです。この一時テーブルからストアドプロシージャを使って、生データのテーブルにデータを書き込みます。
さらに「T売上伝票」の主キー値発番用に「T発番」という名前のテーブルを用意しました。
発番用のストアドプロシージャについては下記リンク先を参照してください。
【Access VBA】主キー値をSQL Serverから取得する - カットマンブログ
Accessには「WT売上伝票」、「WT売上明細」の2つのテーブルを用意しました。


「T売上伝票」、「T売上明細」の間に連鎖削除を設定しました。

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

SQL Serverに「import売上情報」という名前のストアドプロシージャを用意しました。
これにより一時テーブルのデータを生データのテーブルに書き込みます。

ALTER PROCEDURE [dbo].[import売上情報] 	
	
AS
BEGIN	
	SET NOCOUNT ON;
    BEGIN TRY
      BEGIN TRANSACTION
      --T売上伝票更新----------------------------------------------------	
	MERGE INTO [T売上伝票] AS A    
        USING
       (SELECT [伝票番号],[日付] FROM [TEMP売上伝票] WITH(TABLOCKX)) AS B 
        ON
        (A.[伝票番号] = B.[伝票番号])
        WHEN MATCHED THEN    
          UPDATE SET [日付] = B.[日付]        
        WHEN NOT MATCHED THEN
          INSERT ([伝票番号],[日付])
          VALUES (B.[伝票番号],B.[日付]);        
      ---------------------------------------------------------------
      --T売上明細更新-------------------------------------------------		
        MERGE INTO [T売上明細] AS C    
        USING    
        (SELECT [明細ID],[伝票番号],[商品コード],[数量],[削除]
        FROM [TEMP売上明細] WITH(TABLOCKX)) AS D
        ON    
        (C.[明細ID] = D.[明細ID])
        WHEN MATCHED AND D.[削除]=0 THEN
          UPDATE SET [商品コード] =D.[商品コード], [数量] = D.[数量]		            
        WHEN MATCHED AND D.[削除]=1 THEN   
	      DELETE
        WHEN NOT MATCHED AND D.[削除]=0 THEN
          INSERT ([伝票番号],[商品コード],[数量])
          VALUES (D.[伝票番号],D.[商品コード],D.[数量]);
      -------------------------------------------------------------------			
      COMMIT TRANSACTION 
      RETURN-1 
    END TRY

    BEGIN CATCH
      ROLLBACK TRANSACTION		
      RETURN 0
    END CATCH
END

SQL Serverに「SetID」という名前のストアドプロシージャを用意しました。これにより「売上伝票」の主キー値を発番します。以下に「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


リンクテーブルの作成

Accessで「TEMP売上伝票」と「TEMP売上明細」のリンクテーブルを作成しました。
作成方法は下記リンク先を参照してください。
【Access】SQL Serverのリンクテーブル作成 - カットマンブログ


選択クエリの作成

Accessで「Q売上明細」という名前の選択クエリを作成しました。サブフォームのレコードソースとして使用します。


フォームの準備

下のような「Fサンプル」という名前のフォームを作成しました。「伝票一覧」と「売上明細」はサブフォームです。「売上伝票」の部分には非連結のテキストボックス２つを配置しています。


「売上明細」サブフォームでは「伝票番号」と「削除」フィールドを非表示にして、以下の既定値を設定しました。


SQL Serverのテーブルから「売上伝票」と「売上明細」を取得するコードの記述

標準モジュールにAccessのテーブルをクリアし、SQL Serverのテーブルから売上伝票と売上明細を取得するプロシージャ「wtImport」を記述します。

Public Const strCN As String = "driver={ODBC Driver 17 for SQL Server};server=LAPTOP-114315\SQLEXPRESS;DATABASE=sample;uid=administrator;PWD=1111"
Public Sub wtImport(ByVal strWT As String, ByVal strSQL As String)
    Dim w_cn As New ADODB.Connection
    Set w_cn = CurrentProject.AccessConnection
    Dim w_cmd As New ADODB.Command
    w_cmd.ActiveConnection = w_cn
    w_cmd.CommandType = adCmdText
    w_cmd.CommandText = "DELETE FROM " & strWT
    w_cmd.Execute
    w_cmd.CommandText = "INSERT INTO " & strWT & " " & strSQL
    w_cmd.Execute
    Set w_cmd = Nothing
    w_cn.Close: Set w_cn = Nothing
End Sub


SQL Serverの「T売上伝票」から目的のデータを削除するコードの記述

標準モジュールにSQL Serverの「T売上伝票」から目的のデータを削除するプロシージャ「tDelete」を作成しました。

Public Sub tDelete(ByVal intSlipNo As Integer)
    Dim cn As New ADODB.Connection
    cn.Open strCN
    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = cn
    cmd.CommandType = adCmdText
    cmd.CommandText = "DELETE FROM T売上伝票 WHERE 伝票番号=" & intSlipNo
    cmd.Execute
    Set cmd = Nothing
    cn.Close: Set cn = Nothing
End Sub


SQL Serverから主キー値を取得するコードの記述

標準モジュールにSQL Serverから主キー値を取得する関数「GetID」を作成しました。

Public Function GetID(ByRef n As Integer) As Boolean
    Dim cn As New ADODB.Connection
    cn.Open strCN
    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
        n = cmd.Parameters("@ID").Value
        GetID = True
    Else
        MsgBox "エラーが発生しました。", vbExclamation, "確認"
        GetID = False
    End If
    Set cmd = Nothing
    cn.Close: Set cn = Nothing
End Function


Accessのテーブルをクリアするコードの記述

標準モジュールにAccessのテーブルをクリアするプロシージャ「wtDelete」を作成しました。

Public Sub wtDelete(ByVal strWT As String)
    Dim w_cn As New ADODB.Connection
    Set w_cn = CurrentProject.AccessConnection
    Dim w_cmd As New ADODB.Command
    w_cmd.ActiveConnection = w_cn
    w_cmd.CommandType = adCmdText
    w_cmd.CommandText = "DELETE FROM " & strWT
    w_cmd.Execute
    Set w_cmd = Nothing
End Sub


フォーム用プロシージャの記述

「Fサンプル」の読み込み時と、「新規作成」ボタンおよび「保存」ボタンのクリック時のイベントプロシージャに以下のコードを記述しました。

Private Sub Form_Load()
    Dim strSQL As String
    strSQL = "SELECT * FROM T売上伝票 IN ''[ODBC;" & strCN & "] "
    Call wtImport("WT売上伝票", strSQL)
    Me.sub伝票一覧.Requery
    If DCount("*", "WT売上伝票") = 0 Then Exit Sub
    [伝票番号] = Forms![Fサンプル].sub伝票一覧.Form![伝票番号]
    [日付] = Forms![Fサンプル].sub伝票一覧.Form![日付]
    strSQL = "SELECT * FROM T売上明細 IN ''[ODBC;" & strCN & "] WHERE 伝票番号=" & [伝票番号]
    Call wtImport("WT売上明細", strSQL)
    Me.sub売上明細.Requery
End Sub

'「新規作成」ボタンクリック時のプロシージャ----------------------------
Private Sub btnNew_Click()
    Dim n As Integer
    If GetID(n) Then
        [伝票番号] = n
    Else
        [伝票番号] = Null
    End If
    Call wtDelete("WT売上明細")
    [日付] = Null
    Me.Painting = False
    Me.sub売上明細.Requery
    Me.Painting = True
End Sub

'「保存」ボタンクリック時のプロシージャ-------------------------------------
Private Sub btnUpdate_Click()
    If IsNull([伝票番号]) Then Exit Sub
    '売上明細ゼロ件の時、売上伝票を削除する-----------------------------------
    If DCount("*", "Q売上明細") = 0 Then
        Call tDelete([伝票番号])
        [伝票番号] = Null
        [日付] = Null
        GoTo UD
    End If
    '---------------------------------------------------------------------------
    On Error GoTo Errh
    'SQLServerの一時テーブルにAccessのデータを転記する--------------------------
    Dim cn As New ADODB.Connection
    cn.Open strCN
    Dim cmd As New ADODB.Command
    Set cmd = New ADODB.Command
    cmd.ActiveConnection = cn
    cmd.CommandType = adCmdText
    cmd.CommandText = "TRUNCATE TABLE TEMP売上明細"
    cmd.Execute
    cmd.CommandText = "TRUNCATE TABLE TEMP売上伝票"
    cmd.Execute
    
    Dim w_cn As New ADODB.Connection
    Set w_cn = CurrentProject.AccessConnection
    Dim w_cmd As New ADODB.Command
    w_cmd.ActiveConnection = w_cn
    w_cmd.CommandType = adCmdText
    w_cmd.CommandText = "INSERT INTO TEMP売上明細 SELECT * FROM WT売上明細"
    w_cmd.Execute
    
    Dim strSQL As String
    strSQL = "VALUES(" & [伝票番号]
    strSQL = strSQL & ",'" & [日付]
    strSQL = strSQL & "')"
    w_cmd.CommandType = adCmdText
    w_cmd.CommandText = "INSERT INTO TEMP売上伝票 " & strSQL
    w_cmd.Execute
   
    Set w_cmd = Nothing
    w_cn.Close: Set w_cn = Nothing
    On Error GoTo 0
    '---------------------------------------------------------------------------
    'SQLServerの一時テーブルから生データテーブルに転記する----------------------
    cmd.CommandType = adCmdStoredProc
    cmd.CommandText = "import売上情報"
    
    cmd.Parameters.Append cmd.CreateParameter(, adInteger, adParamReturnValue, , Null)
    cmd.Execute
    
    If CBool(cmd.Parameters(0).Value) Then
        GoTo UD
    Else
        MsgBox "エラーが発生しました。", vbExclamation, "確認"
        Set cmd = Nothing
        cn.Close: Set cn = Nothing
        Exit Sub
    End If
    '---------------------------------------------------------------------------
UD:
    Set cmd = Nothing
    cn.Close: Set cn = Nothing
    Me.Painting = False
    strSQL = "SELECT * FROM T売上伝票 IN ''[ODBC;" & strCN & "] "
    Call wtImport("WT売上伝票", strSQL)
    
    Me.sub伝票一覧.Requery
    If Not IsNull([伝票番号]) Then
        Me.sub伝票一覧.Form.Recordset.FindFirst "伝票番号=" & [伝票番号]
    End If
    Me.Painting = True
    If DCount("*", "WT売上伝票") <> 0 Then
        [伝票番号] = Me.sub伝票一覧.Form.[伝票番号]
        [日付] = Me.sub伝票一覧.Form.[日付]
    
        strSQL = "SELECT * FROM T売上明細 IN ''[ODBC;" & strCN & "]" _
                        & "WHERE 伝票番号=" & [伝票番号]
    
        Call wtImport("WT売上明細", strSQL)
        Me.Painting = False
        Me.sub売上明細.Requery
        Me.Painting = True
    End If
    MsgBox "保存しました。", vbInformation, "確認"
    Exit Sub
Errh:
    MsgBox "エラーが発生しました。", vbExclamation, "確認"
End Sub


サブフォーム用プロシージャの記述

「F伝票一覧」のクリック時に以下のイベントプロシージャを記述しました。

Public Sub Form_Click()
    Forms![Fサンプル].[伝票番号] = [伝票番号]
    Forms![Fサンプル].[日付] = [日付]
    Dim strSQL As String
    strSQL = "SELECT * FROM T売上明細 IN ''[ODBC;" & strCN & "] WHERE 伝票番号=" & [伝票番号]
    Call wtImport("WT売上明細", strSQL)
    Forms![Fサンプル].sub売上明細.Form.Painting = False
    Forms![Fサンプル].sub売上明細.Requery
    Forms![Fサンプル].sub売上明細.Form.Painting = True
End Sub

「F売上明細」の「削除」ボタンのクリック時に以下のイベントプロシージャを記述しました。

Private Sub btnDelete_Click()
    If Me.NewRecord Then
        MsgBox "新規レコードは削除できません。"
        Exit Sub
    End If

    [削除] = True
    Me.Requery
End Sub