ExcelVBAとAccessの連携 番外2-2 続・プレースホルダを使ったSQL実行（汎用化）

前回書いた1プロシージャ完結の読み書きを分割して、SQLとパラメーターだけ渡せば汎用的に使える関数にしたものです。書けば書くほど、「需要～～～～！！！？！？」という気分になりますが、せっかくなので書いておきますね！

関連記事

• 第1回 Excelからデータベースへの接続
• 第2回 テーブル設計とシート&コードの準備
• 第3回 SQLを使った読み書きの処理
• 第4回 条件を絞ってデータを読み込む
• 第5回 レコードの更新・削除
• 第6回 トランザクション処理
• 番外1 リファクタリングしたコード
• 番外2-1 プレースホルダを使ったSQL実行
• 番外2-2 続・プレースホルダを使ったSQL実行（汎用化） ←NOW!

Accessの接続/接続解除のためのコード

DBに接続したり処理したりする部分の実働部分を記載するモジュールを作ります。新規標準モジュールで、オブジェクト名をAccessExchangeとします（任意です）。このあたりは前のと一緒です。ADOコネクション用の変数はモジュールレベルのためm_をつけています。

'# AccessExchange
Option Explicit
Private m_cn As Object 'ADOコネクション用オブジェクトの宣言
Private Const adStateOpen = 1 'レコードセットが開いている場合の設定値
Private Const adOpenKeyset = 1 'レコードセットカーソルタイプの設定値
  
Private Sub connectDB()
  '## 接続
  
  Set m_cn = CreateObject("ADODB.Connection") 'ADOコネクションを作成
  m_cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=C:\data.accdb;" 'Accessファイルを指定してコネクションを開く
End Sub

Private Sub disconnectDB()
  '## 接続解除
  
  If Not m_cn Is Nothing Then
    m_cn.Close
    Set m_cn = Nothing
  End If
End Sub

パラメーターは配列で指定するので、配列いっぱい使います。パラメータなしで使いたいときは空の配列を使うことになるので、先に配列を空判定する関数も書いておきます。

Public Function isEmptyArray(ByVal tgtAry As Variant) As Boolean
  '## 配列が空か判定
  
  On Error GoTo Err_Handler 'エラーが起きたら「ErrorHandler」にジャンプする指示
  If UBound(tgtAry) >= 0 Then '配列に要素が存在したら
    Exit Function '終了（Falseを返す）
  End If
  
Err_Handler: 'エラーもしくは要素が存在しない場合
  isEmptyArray = True 'Trueを返す
End Function

INSERT, UPDATE, DELETE

AccessExchangeモジュールに以下を追記します。レコードの挿入・更新・削除を行うプロシージャです。トランザクションもついています。

Public Function tryExecute(ByVal sqlList As Collection, ByVal paramList As Collection) As Boolean
  '## SQLの実行
  
  On Error GoTo ErrorHandler 'エラーが起きたら「ErrorHandler」にジャンプする指示
  
  Call connectDB '接続

  m_cn.BeginTrans 'トランザクション開始
  
  '実行
  Dim i As Long, cmd As Object
  For i = 1 To sqlList.count
    'ADOコマンドオブジェクトの設定
    Set cmd = CreateObject("ADODB.Command")
    cmd.ActiveConnection = m_cn
    
    'コマンドの実行
    cmd.CommandText = sqlList(i) 'SQL
    If isEmptyArray(paramList(i)) Then
      cmd.Execute 'パラメーターなし
    Else
      cmd.Execute Parameters:=paramList(i) 'パラメーターあり
    End If
    
    'コマンドオブジェクトの初期化
    Set cmd = Nothing
  Next i
  
  m_cn.CommitTrans '確定
  
  tryExecute = True '成功だった場合、関数の結果にTrueを入れる
  GoTo Finally '正常に終了したら最終処理へジャンプ
  
ErrorHandler:   '例外処理（エラーが起きたらここへジャンプ）
  m_cn.RollbackTrans '元の状態へ戻す
  Dim msgTxt As String
  msgTxt = "Error #: " & Err.Number & vbNewLine & vbNewLine & Err.Description 'エラーメッセージ格納
  MsgBox msgTxt, vbOKOnly + vbCritical, "エラー" 'メッセージ出力
  
Finally: '最終処理
  'コマンドオブジェクトの処理
  If Not cmd Is Nothing Then
    Set cmd = Nothing
  End If
  
  Call disconnectDB '接続解除
End Function

コレクション型のSQL文とパラメーターを、それぞれ引数にして上記のプロシージャを呼び出せば実行できます。処理の度にコマンドオブジェクトを作り直しているので、その都度パラメーターの有無や数が変わっても動きます。私の環境では動きました。

上記を利用するプロシージャの例として、任意のモジュールに以下のように書きます。SQLはString型でコレクションに、パラメーターは配列型でコレクションに、それぞれ同数で格納しています。同数じゃないとズレちゃうので、パラメーターなしの場合は空の配列を入れています。

Sub ExecuteSQL()
  '## SQLの実行
  
  'SQL用コレクションの作成
  Dim sqlList As Collection
  Set sqlList = New Collection
  
  'パラメーター用コレクションの作成
  Dim paramList As Collection
  Set paramList = New Collection
  
  '1つ目
  sqlList.Add "DELETE FROM T1;" 'SQL
  paramList.Add Array() 'パラメータ（なしの場合は空）
  
  '2つ目
  sqlList.Add "INSERT INTO T1(f1, f2, f3, f4) VALUES(?, ?, ?, ?);"
  paramList.Add Array(v1, v2, v3, v4)

  '3つ目  
  sqlList.Add "INSERT INTO T1(f1, f2, f3, f4) VALUES(v1, ?, v3, ?);"
  paramList.Add Array(v2, v4)
  
  '4つ目
  sqlList.Add "UPDATE T1 SET f2=? WHERE f1=v1;"
  paramList.Add Array(v2)
            
  '実行
  If tryExecute(sqlList, paramList) Then '処理が成功した場合
    MsgBox "正常に追加されました", vbOKCancel + vbInformation, "終了" '終了メッセージ
  End If
  
End Sub

こんなふうにパラメーターの位置や数などバラバラでも。失敗した場合はエラーメッセージが、成功した場合は終了メッセージが出力されます。

SELECT（二次元配列に入れて受け取る）

AccessExchangeに以下を追記します。抽出したレコードセットを二次元配列に入れて受け取ります。

Public Function getRsInArray(ByVal sql As String, ByVal param As Variant) As Variant
  '## レコードセットを配列へ入れて返す
  
  On Error GoTo Err_Handler 'エラーが起きたら「ErrorHandler」にジャンプする指示
  
  Call connectDB '接続
  
  'ADOコマンドオブジェクトの設定
  Dim cmd As Object
  Set cmd = CreateObject("ADODB.Command")
  cmd.ActiveConnection = m_cn
  
  '実行
  cmd.CommandText = sql
  If isEmptyArray(param) Then
    cmd.Execute 'パラメーターなし
  Else
    cmd.Execute Parameters:=param 'パラメーターあり
  End If
  
  'ADOレコードセットオブジェクトの設定
  Dim rs As Object
  Set rs = CreateObject("ADODB.RecordSet")
  rs.Open cmd, , adOpenKeyset 'レコードセットを取得
  
  '空だったら最終処理へ
  If rs Is Nothing Or (rs.BOF And rs.EOF) Then 'レコードセットやレコードが存在しなかった場合
    getRsInArray = Array() '空の配列を返す
    GoTo Finally '最終処理へジャンプ
  End If
  
  '配列に展開
  Dim ary() As Variant
  ReDim ary(rs.recordCount - 1, rs.Fields.count - 1) '配列の要素数を定義
  Dim rsNum As Long '縦要素（レコードセット）の繰り返し用変数
  Dim fldNum As Long '横要素（フィールド）の繰り返し用変数
  Do Until rs.EOF 'レコードセットが終了するまで処理を繰り返す
    For fldNum = 0 To rs.Fields.count - 1 'フィールドの数だけ繰り返す
      ary(rsNum, fldNum) = rs(fldNum) '配列に格納
    Next fldNum
    rsNum = rsNum + 1 '縦要素をカウントアップする
    rs.MoveNext '次のレコードに移動する
  Loop
  
  getRsInArray = ary '配列を返す
  
  GoTo Finally '正常に終了したら最終処理へジャンプ
  
Err_Handler: '例外処理
  Dim msgTxt As String
  msgTxt = "Error #: " & Err.Number & vbNewLine & vbNewLine & Err.Description 'エラーメッセージが入る
  MsgBox msgTxt, vbOKOnly + vbCritical, "エラー" 'メッセージ出力
  getRsInArray = Array() '空の配列を返す
  
Finally: '最終処理
  'レコードセットオブジェクトの処理
  If Not rs Is Nothing Then
    If rs.State = adStateOpen Then rs.Close 'レコードセットが開いていたら閉じる
    Set rs = Nothing
  End If
  
  'コマンドオブジェクトの処理
  If Not cmd Is Nothing Then
    Set cmd = Nothing
  End If
  
  Call disconnectDB '接続解除
End Function

String型のSQL文と配列型のパラメーターを、それぞれ引数にして呼び出します。上記を利用するプロシージャの例として、任意のモジュールに以下のように書きます。

Sub loadRecord()
  '## レコードを配列へ
    
  'SQL作成
  Dim sql As String 'SQL用変数
  Dim param() As Variant 'パラメーター用配列

  'パラメーターなしの場合
  sql = "SELECT * FROM T1"
  param = Array()
  
  'パラメーターありの場合  
  sql = "SELECT * FROM T1 WHERE f1=? AND f2=?;"
  param = Array(v1, v2)
  
  'レコードセットを配列で取得
  Dim ary() As Variant
  ary = getRsInArray(sql, param)
  
  If isEmptyArray(ary) Then Exit Sub '空の配列だったら終了
  
  '中身の確認
  Dim rsCount As Long: rsCount = UBound(ary, 1) '第1要素（レコード）数
  Dim fldCount As Long: fldCount = UBound(ary, 2) '第2要素（フィールド）数
  Dim x As Long, y As Long
  For x = 0 To rsCount
    For y = 0 To fldCount
      Debug.Print ary(x, y), ; 'フィールドを改行せずイミディエイトウィンドウに出力
    Next y
    Debug.Print "" 'レコード切り替えでイミディエイトウィンドウを改行
  Next x
End Sub

パラメーターは有りでも無しでも動きます。無しの場合は空配列を引数にします。

以上です。自分でも使うかと言われるとわからないのですが、いつかどこかで役に立つかもしれない。