改善項目を検証する-2(Excelデータベースその13)

ExcelVBA-Excelファイルをデータベースとして使う-その13です。 前回の記事はこちらになります。
hirocom777.hatenadiary.org

改善ポイントの動作を確認する-2

　前回はクラスモジュールの改善した機能のうちテーブル選択機能を検証しました。今回はトランザクション機能について検証していきましょう。

トランザクション機能の確認

　改善したクラスモジュールではトランザクション機能により柔軟にトランザクションの設定が出来るようになっています。書き込みを行う際には自動的にトランザクションが設定されますし、任意のタイミングでトランザクション機能のON/OFFができます。トランザクション機能は何を保護してくれるのでしょうか？確認してみましょう。

まず、クラスモジュールを組み込んだExcelファイルを用意します。ワークシートには以下のプロシージャを配置してください。

'別々の接続からデータを追加する
Private Sub TransactionTest()
Dim recordData() As Variant
  Dim db1 As clsExcelDbase
  Set db1 = New clsExcelDbase
  db1.dbFileName = ThisWorkbook.Path & "\データ.xlsx"
  db1.dbTableName = "Sheet1$"
  
  Dim db2 As clsExcelDbase
  Set db2 = New clsExcelDbase
  db2.dbFileName = ThisWorkbook.Path & "\データ.xlsx"
  db2.dbTableName = "Sheet1$"
  
  recordData() = Array(Format$(Now, "YYYY/MM/DD hh:mm:ss"), "青山一郎", "男性", "AB", 30)
  db1.AddRecord recordData()
 
  recordData() = Array(Format$(Now, "YYYY/MM/DD hh:mm:ss"), "中山洋子", "女性", "O", 22)
  db2.AddRecord recordData()
End Sub

一つのデータベースに対して2つのオブジェクトを生成してそれぞれ接続しています。1つ目のデータ書き込み時にデータベースに対してトランザクションを自動設定します。書き込みが終了してもトランザクションは無効になりません。2つ目の接続に対する書き込みを実行した際にエラーが発生するのではないのでしょうか？Excelファイルと同じ場所にシート"Sheet1"をもつExcelファイル"データ.xlsx"を用意してください。

この状態で上のプロシージャを実行してみます。すると・・・

あれ？2件とも書き込まれていますね。1件目で設定したトランザクションは2件目の書込みに影響していません。他にも色々試してみたのですが、トランザクションが機能した様な例はありませんでした。それでは書き方や解釈が間違っていなかったかと言うと、そうでもないようなんです。実は、同じ内容をAccessデータベースファイルでも試してみました。クラス化しておくと、ここら辺は簡単な変更(Extended Propertiesの指定とテーブル指定方法などの変更)でできます。こちらは2件目の書き込み時にエラーが発生して止まりました。1件目の書込みの後トランザクションを無効にする(dbTransプロパティーをFalseに設定)と、エラーは発生せず2件目の書込みも実行されます。トランザクションがきいているんですね。どうやらExcelファイルではトランザクションの効果はあまり期待できないようです。しかしながらBeginTrans などのメソッドを記述実行可能ということは、何かしらの機能はあるのかもしれません。ここら辺は引き続き調査します。

編集機能

　もう一つ報告があります。今までExcelファイルのデータベース化について、編集機能に触れていなかったのですが編集できることが判明しました。これに伴いクラスモジュールにEditRecordメソッドを追加しました。ソースは以下のようになります。

'SQLのWHERE句指定でレコードを抽出して指定フィールドのデータを変更します
Public Function EditRecord(cmdSql As String, fieldName As String, setData As Variant) As Long
  adoSelectRs.Open "SELECT * FROM [" & dbTableName_ & "]  WHERE " & cmdSql, adoCn, adOpenKeyset, adLockOptimistic
  If adoSelectRs.recordCount <> 1 Then
    MsgBox "レコードが一つに絞られていません"
  Else
    adoSelectRs.Fields(fieldName).Value = setData
    adoSelectRs.Update
  End If
  adoSelectRs.Close
End Function

cmdSqlのSQLコマンドで絞られたレコードのfieldNameで指定したフィールドのデータをsetDataに書き換えます。レコードが1件に絞れない場合は書き換え実行しません。(最後にクラスモジュール全体のソースリストを載せます)

動作を確認してみましょう。上の実証で使ったファイル"データ.xlsx"に書き込んだデータのうち中山洋子さんの血液型データをO型からA型に修正してみましょう。クラスモジュールを実装したExcelファイルのシートに以下のプロシージャを組み込んで実行してください。

Private Sub EditData()
Dim recordData() As Variant
  Dim db As clsExcelDbase
  Set db = New clsExcelDbase
  db.dbFileName = ThisWorkbook.Path & "\データ.xlsx"
  db.dbTableName = "Sheet1$"
  db.EditRecord "氏名 = '中山洋子'", "血液型", "A"
End Sub

実行した結果は、以下のようになりました。

ちゃんと書き換えできていますね。

最後に、トランザクション機能を削除して編集機能を追加したクラスモジュールの全ソースリストを掲載します。これで、このクラスモジュールは完成です。

Option Explicit
'Excelファイルのデータベースコントロールのクラスです

Private dbFileName_ As String 'データベースファイル名
Private dbTableName_ As String 'テーブル名
Private dbFieldList_() As Variant 'フィールドリスト

Private adoCn As Object
Private adoRs As Object
Private adoSelectRs As Object

'初期化
Private Sub Class_Initialize()
  Set adoCn = CreateObject("ADODB.Connection")
  adoCn.Provider = "Microsoft.ACE.OLEDB.12.0"
  adoCn.Properties("Extended Properties") = "Excel 12.0"
  Set adoRs = CreateObject("ADODB.Recordset")
  adoRs.CursorLocation = adUseClient
  Set adoSelectRs = CreateObject("ADODB.Recordset")
  adoSelectRs.CursorLocation = adUseClient
End Sub
 
'終了処理
Private Sub Class_Terminate()
  If Err.Number <> 0 Then
    MsgBox "データベース接続に失敗しました-" & Err.Number
  End If
  On Error Resume Next 'クローズ時はエラー発生後も継続
  If adoRs.State = adStateOpen Then adoRs.Close
  If adoSelectRs.State = adStateOpen Then adoSelectRs.Close
  If adoCn.State = adStateOpen Then adoCn.Close
End Sub

'ファイル名を設定します
Public Property Let dbFileName(ByVal fileName As String)
  Select Case True
  Case dbFileName_ <> ""
    MsgBox "ファイル名は途中で変更できません"
  Case Dir$(fileName) = ""
    MsgBox "ファイルが見つかりません"
  Case Else
    dbFileName_ = fileName
  End Select
End Property

'ファイル名を取得します
Public Property Get dbFileName() As String
  dbFileName = dbFileName_
End Property

'テーブル名を設定します
Public Property Let dbTableName(ByVal tableName As String)
  Select Case True
  Case Dir$(dbFileName_) = ""
    MsgBox "データベースファイルを指定してください"
  Case dbTableName_ <> ""
    MsgBox "テーブル名は途中で変更できません"
  Case Else
    adoCn.Open dbFileName_
    adoRs.Open "[" & tableName & "]", adoCn, adOpenKeyset, adLockOptimistic
    dbTableName_ = tableName

    'フィールドリストを設定します
    Dim adoField As ADODB.Field
    Dim i As Long: i = 0
    ReDim dbFieldList_(adoRs.Fields.Count - 1)
    For Each adoField In adoRs.Fields
      dbFieldList_(i) = adoField.Name
      i = i + 1
    Next
  End Select
End Property

'テーブル名を取得します
Public Property Get dbTableName() As String
  dbTableName = dbTableName_
End Property

'フィールドリストを取得します
Public Property Get dbFieldList() As Variant()
  dbFieldList = dbFieldList_
End Property

'Excelデータベースにレコードを追加します
Public Sub AddRecord(recordData() As Variant)
  adoRs.AddNew dbFieldList_, recordData
  adoRs.Update
End Sub

'SQLのWHERE句指定でレコードを抽出して指定のセルに表示します
Public Function SelectRecord(cmdSql As String, Optional foundRecord As Range = Nothing) As Long
  adoSelectRs.Open "SELECT * FROM [" & dbTableName_ & "]  WHERE " & cmdSql, adoCn
  If Not foundRecord Is Nothing Then foundRecord.CopyFromRecordset adoSelectRs
  SelectRecord = adoSelectRs.recordCount
  adoSelectRs.Close
End Function

'SQLのWHERE句指定でレコードを抽出して指定フィールドのデータを変更します
Public Function EditRecord(cmdSql As String, fieldName As String, setData As Variant) As Long
  adoSelectRs.Open "SELECT * FROM [" & dbTableName_ & "]  WHERE " & cmdSql, adoCn, adOpenKeyset, adLockOptimistic
  If adoSelectRs.recordCount <> 1 Then
    MsgBox "レコードが一つに絞られていません"
  Else
    adoSelectRs.Fields(fieldName).Value = setData
    adoSelectRs.Update
  End If
  adoSelectRs.Close
End Function

次回は、このクラスモジュールを使って簡単なデータベースツールを作ってみたいと思います。
hirocom777.hatenadiary.org

ExcelVBA-Excelファイルをデータベースとして使う連載はコチラからどうぞ！！