ExcelVBAとAccessの連携 第5回 レコードの更新・削除

お久しぶりの、ExcelからAccessのデータベースをごにょごにょしちゃう記事の続きです。登録したツイートを更新したり削除する機能をつけてみます。（実際のtwitterは更新機能はないですが）

関連記事

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

下準備

レコードセットオブジェクトの有無

前回までで紹介してきたコードでは、SQL文を書いた後に

adoRs.Open strSQL, adoCn

という部分がありました。これは、すでに存在しているレコードを開くときに使うもので、今回紹介する、更新・削除の操作には使わないものなんです。

Sub DBconnect() 'DB接続プロシージャ
  Set adoCn = CreateObject("ADODB.Connection") 'ADOコネクションオブジェクトを作成
  Set adoRs = CreateObject("ADODB.Recordset") 'ADOレコードセットオブジェクトを作成
  adoCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBpath & ";" 'Accessファイル（～2003）を開く
  'adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBpath & ";" 'Accessファイル（2007～）を開く
End Sub

Sub DBcut_off() 'DB切断プロシージャ
  adoRs.Close 'レコードセットのクローズ
  adoCn.Close 'コネクションのクローズ
  Set adoRs = Nothing 'オブジェクトの破棄
  Set adoCn = Nothing
End Sub

前に書いたこの接続・切断のコードでは、adoRsを使わない処理の場合、レコードセットをクローズしようとするとき（9行目の部分）に、「使ってないのにクローズできないよ！」とエラーになってしまうのです。

なので、下記のように書き換えます。

Sub DBconnect(flg As Boolean) 'DB接続プロシージャ
  Set adoCn = CreateObject("ADODB.Connection") 'ADOコネクションオブジェクトを作成
  If flg = True Then Set adoRs = CreateObject("ADODB.Recordset") 'ADOレコードセットオブジェクトを作成
  adoCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBpath & ";" 'Accessファイル（～2003）を開く
  'adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBpath & ";" 'Accessファイル（2007～）を開く
End Sub

Sub DBcut_off(flg As Boolean) 'DB切断プロシージャ
  If flg = True Then
    adoRs.Close 'レコードセットのクローズ
    Set adoRs = Nothing
  End If
  adoCn.Close 'コネクションのクローズ
  Set adoCn = Nothing
End Sub

flgというBoolean変数（TrueかFalseの二択）をつくり、Trueのときだけレコードセットオブジェクトを使用する、という形にします。

そして各処理から呼び出す際に、

Call DBconnect(True) 'DB接続

と書けばレコードセットオブジェクトを使用できて、

Call DBconnect(False) 'DB接続

と書けばレコードセットオブジェクトを使用しない、という使い分けが出来るようになります。

引数（カッコ内のTrue/False）は省略できないので、前回までに書いたコードの接続・切断の呼び出し部分も全てこのように変更してください。

Sub プロフ表示/書き込み/ツイート読み込み
  Call DBconnect(True) 'DB接続

  '処理

  Call DBcut_off(True) 'DB切断
End Sub

ボタンの追加

更新と削除用のボタンを追加します。

Sub DBedit() 'ツイート更新
  Call DBconnect(False) 'DB接続

  '処理

  Call DBcut_off(False) 'DB切断
End Sub

Sub DBdelete() 'ツイート削除
  Call DBconnect(False) 'DB接続

  '処理

  Call DBcut_off(False) 'DB切断
End Sub

モジュールに新たに更新・削除用のプロシージャを追加して、それぞれさっき作ったボタンから起動できるようにしておきます。

更新

データを更新するSQL

基本形はこんな感じ。内容1,内容2,内容3…のようにカンマで区切って複数更新もできます。修正したい内容は変数tw_strに予め入れておくとして、問題は「どのナンバーか」を特定するところです。番号を入力してもらうなど方法はいくつかありますが、今回は、更新したいツイートNoのセルを選択した状態で更新ボタンを押してもらうというルールにしてみます。

テーブル名などを当てはめて、変数に置き換えたSQL文は、こんな感じ。

コード

Sub DBedit() 'ツイート更新
  Dim tw_str As String

  If ActiveCell = "" Or IsNumeric(ActiveCell) = False Then
    MsgBox "更新したいツイート番号を選択してください。"
    Exit Sub
  End If

  tw_str = InputBox("更新後のテキストを入力してください")
  If tw_str = "False" Or tw_str = "" Then Exit Sub

  Call DBconnect(False) 'DB接続

  'ツイート更新のSQL
  strSQL = _
    "UPDATE t_tweet " & _
    "SET f_content='" & tw_str & "' " & _
    "WHERE f_no=" & ActiveCell
  adoCn.Execute strSQL '実行

  MsgBox "正常に更新完了しました"

  Call DBcut_off(False) 'DB切断
End Sub

4～7行目は、選択されているセル（アクティブセル）が空白または数値じゃなかったら処理を終了する、ということを書いています。9行目では更新するテキストの入力要求を行い、10行目でそれが空、またはキャンセル（False）なら処理を終了します。

ナンバーとテキスト両方が正常に取得できたら、DBへ接続、SQL文の実行へ進みます。このコードではレコードセットオブジェクト（adoRs）を使っていないので、接続・切断の引数はFalseにしておきます。

では実際に5番を選択して更新ボタンを押して、修正してみましょう。

正常に終了したら、読み込みしてみてください。（データ更新しかしてないので、読込ボタンを押さないと画面に出てこないのでご注意。）うまくできたでしょうか？

削除

データを削除するSQL

基本形。WHERE以下の条件を指定しないと、テーブルの中身を全て削除します。

コード

Sub DBdelete() 'ツイート削除
  If ActiveCell = "" Or IsNumeric(ActiveCell) = False Then
    MsgBox "削除したいツイート番号を選択してください。"
    Exit Sub
  End If

  If MsgBox("No." & ActiveCell & "のツイートを削除します。よろしいですか？", vbOKCancel) <> 1 Then Exit Sub

  Call DBconnect(False) 'DB接続

  'ツイート削除のSQL
  strSQL = _
    "DELETE FROM t_tweet " & _
    "WHERE f_no=" & ActiveCell
  adoCn.Execute strSQL '実行

  MsgBox "正常に削除完了しました"

  Call DBcut_off(False) 'DB切断
End Sub

更新のときとそんなに変わらないので図解は省きましたが、ポイントとしてはハイライトしてある7行目でしょうか。データの削除前にはユーザーに確認を出すのが親切だと思います。MsgBox("説明文", vbOKCancel)では、押されたボタンがOKなら1,Cancelなら2が返ってきます。✕を押されることもあるので、1（OK）以外なら終了、という書き方をしています。

実際に5番を選択して削除ボタンを押してみます。

読込してみましょう。出てこなければ成功です。

あと1回です

少しずつ書き進めていましたが、次回、トランザクション実装を紹介して終了の予定です。よろしければご期待ください。

追記

複数の処理をループさせるには、という質問を頂いたので書いてみました。

サンプルはこのような形。ご提案頂いたものは、「この行（レコード）をUPDATEする」ということをどこかに印をつけておいてループできないか、というものでした。

もちろんそれでも実装可能なのですが、1行全部UPDATEしていくよりは、変更されたセルの色を変えておいて、セル（フィールド）単位でピンポイントにUPDATEしたほうが無駄が少ないんじゃないかな、という構想で書いてみます。

変更されたセルを赤字に

まずはセルが変更されたら走るコード。

任意シートのコード画面

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Long, c As Long
  
  c = Target.Column '変更されたセルの列
  r = Target.Row '変更されたセルの行
  If c < 3 Or 5 < c Or r < 3 Or 8 < r Then Exit Sub '範囲外なら終了
  Cells(r, c).Font.ColorIndex = 3
End Sub

全てのセルに適用されても困るので、範囲を決めてそれ以外は終了するようにしています。IDはそもそも変えてはいけませんので範囲外にします。

Worksheet_Changeは便利ですが、どんな場面でも変更があると走ってしまうので煩わしいということもあります。特に、SELECT文で読込をしたいだけなのに走ってしまうと非常にアレなので、そういう時は

Sub 読込()
  Call DBconnect(True) 'DB接続
  
  strSQL = "SELECT xxx FROM xxx"
  adoRs.Open strSQL, adoCn 'SQLを実行して対象をRecordSetへ
  Application.EnableEvents = False 'イベントオフ
  Range("B3").CopyFromRecordset adoRs '貼り付け
  Application.EnableEvents = True 'イベントオン
  
  Call DBcut_off(True) 'DB切断
End Sub

のようにイベントを一時停止することができます。Trueに戻すのをお忘れなく！

赤字部分だけUPDATEする

セルが特定できたら、今度は対応するテーブル名とフィールド名を特定しなければなりません。ここで、配列というものを使ってみます。

t_ary = Array("t_StkMng", "t_StkMng", "t_StkMng") '各内容が0,1,2に対応する
f_ary = Array("f_item", "f_size", "f_stock")

このように書くと、f_ary(0)ならf_item、f_ary(1)ならf_size、となります。今回の例はテーブル名は全て一緒にしてますが、もちろん違う名前のテーブルが混ざっても構いません。（実務では複数のテーブルを使うことが多いと思うので）

Module

Sub DBedit() '更新
  Dim t_ary As Variant, f_ary As Variant, i As Integer, j As Integer
  
  t_ary = Array("t_StkMng", "t_StkMng", "t_StkMng") '各内容が0,1,2に対応する
  f_ary = Array("f_item", "f_size", "f_stock")
  
  Call DBconnect(False) 'DB接続

  On Error GoTo Err_Handler 'エラーが起きたら"Err_Handler"へ
  adoCn.BeginTrans 'トランザクション開始
  
  For j = 3 To 8 '行
    For i = 3 To 5 '列
      If Cells(j, i).Font.ColorIndex = 3 Then '赤字だったら
        strSQL = _
          "UPDATE " & t_ary(i - 3) & " " & _
          "SET " & f_ary(i - 3) & "='" & Cells(j, i) & "' " & _
          "WHERE f_id=" & Cells(j, 2)
        adoCn.Execute strSQL '実行
        Cells(j, i).Font.ColorIndex = xlAutomatic 'フォント色を初期化
      End If
    Next i
  Next j

  adoCn.CommitTrans 'トランザクション終了（確定処理）
  Call DBcut_off(False) 'DB切断
 
  MsgBox "正常に更新完了しました"
  Exit Sub '正常ならここで終了
 
Err_Handler: 'エラーが起きたらここへ飛ぶ
  adoCn.RollbackTrans 'ロールバック
  Call DBcut_off(False) 'DB切断
  MsgBox Error$ 'エラーメッセージ表示
End Sub

赤文字の部分のみ処理するようにIf文を使い、「該当セルの列番号-3」がちょうど対応した配列番号になるのを利用します。あとはセル内容などを使ってUPDATE文を成形し、終わったらフォント色を戻しています。

また、このように複数の処理をまとめて実行するときほどトランザクションは有用なので、そちらも盛り込んでみました。（トランザクションがどういうものか、ということについては第6回をご参照ください。）