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
パラメーターは有りでも無しでも動きます。無しの場合は空配列を引数にします。
以上です。自分でも使うかと言われるとわからないのですが、いつかどこかで役に立つかもしれない。
ExcelVBAに興味をお持ちの方は、こちらの記事もどうぞ!
- これからExcelのマクロを始めたいという方に!簡単な練習問題作りました。
- 私がExcelVBAでよく使う便利なコード・スニペットまとめ
- プログラム初心者さんへ贈る、エラーが起きたら試してみて欲しいこと
- ExcelVBAのクラスモジュールって何?という人向けの使い方まとめ
書籍を執筆しています。
コメントは承認制ですので、反映までしばらくお待ち下さい。(稀にスパムの誤判定にて届かないこともあるようですので、必要な際はお問い合わせからお願い致します。)
YouTubeでQ&Aコンテンツを企画しています
運営しているYouTubeチャンネルで、ご相談やご質問を募集しています。動画のコメントやお問い合わせページからお気軽にご相談をお寄せください。