更に実用的なクラスモジュールへ！(Excelデータベースその11)

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

整理してみよう

　前回まででクラスモジュールの大枠が出来ました。ここで、一度『Excelファイルをデータベースとして使う』件について簡単に整理してみると以下のようになると思います。Excelファイルをデータベースとして使うと・・・

・Excelだけで簡単なデータベースシステムが構築できる。
・データベースファイルの内容を簡単に確認、編集、活用できる。
・SQLを使用して複雑な検索をすることができる。
・同一ネットワーク内で複数の端末から安全にアクセス可能。
・アクセススピードが速い。

等の利点があります。ただし、

・扱えるレコード数が少ない(と、言っても約100万行)
・レコードの編集、削除ができない

などの制約があります。これらの特徴を理解して適切な用途に使用するのがいいと思います。具体的に言うと、データを追加して登録していく業務が主流の管理台帳などでしょうか？
データベース自体の編集については、割り切ってExcelファイルを直接開いて編集しましょう。Excelなんですからね！！

そして今回は、クラスモジュールをさらに実用的に改善してみました。

トランザクション機能の改善

　トランザクションはデータベースの信頼性向上に必要不可欠な機能です。今までのクラスモジュールではデータベースのテーブルを指定した時点でトランザクション設定をして、オブジェクトを破棄する際にコミット(変更を確定)していました。当たり前ですが、それだと作業している間他の端末からの書き込みができないです。本当にトランザクションが必要なのは、書き込みの前後が殆ど。(Excelファイルをデータベースにする場合、レコードの削除、編集はできないので)
　そこでトランザクションの設定をプロパティーを使って出来るようにしました。これで柔軟にトランザクションを制御できます。レコードを追加する際には、プロパティーを確認して自動的にトランザクションを開始(BeginTrans)するようにしてあります。一通りの処理が終わったらトランザクション終了すると自動的に追加内容が有効(CommitTrans)になります。忘れた場合でも、オブジェクトを破棄する際に自動的に変更内容が有効になります。また、レコード追加をしなくても任意のタイミングでトランザクションを開始できます。これでほかの端末からの変更を禁止してデータベースを確認することもできます。
　エラー発生時の場合でもプロパティーでトランザクションの状態を確認して、確実に変更内容を無効(RollbackTrans)にします。

テーブル選択機能の改善

　データベースに接続する際に、当然テーブルを指定します。今までのクラスモジュールではExcelファイルのシートをテーブルとして指定していました。でも、実をいうとシート以外にもテーブルを指定する方法があるのです。テーブルを指定する方法は、以下の3つになります。

・シートを指定
　　[シート名$]
・セル範囲を指定
　　[シート名$範囲]
・名前付きセル範囲を指定
　　 [範囲名]

　つまり、シート以外にも特定の範囲に区切ってテーブルとして指定できるということです。一つのシート内でも複数のテーブルを個別にデータベースとして制御できます。今まではシート指定のみを対象としていたのでクラスモジュール内でシート名に"$"をつけていましたが、こちらを廃止します。これで、シート上の特定の範囲をテーブルとして指定することも、名前付きセル範囲を指定することもできます。シート自体ををテーブルとして指定する際はシート名の後に"$"をつけてプロパティーに設定するように変更します。

クラスモジュール

　実際のクラスモジュールは、以下のようになりました。（2021/1/11修正しました）

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

Private dbFileName_ As String 'データベースファイル名
Private dbTableName_ As String 'テーブル名
Private dbFieldList_() As Variant 'フィールドリスト
Private dbTrans_ As Boolean 'トランザクション状態

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
  dbTrans_ = False
End Sub
 
'終了処理
Private Sub Class_Terminate()
  If Err.Number <> 0 Then
    MsgBox "データベース接続に失敗しました-" & Err.Number
    If dbTrans_ Then adoCn.RollbackTrans
  Else
    Me.dbTrans = False
  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
    ReDim dbFieldList_(adoRs.Fields.Count - 1)
    For i = 0 To UBound(dbFieldList_)
      dbFieldList_(i) = adoRs.Fields.Item(i).Name
    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

'トランザクション状態を設定します
Public Property Let dbTrans(transStatus As Boolean)
  Select Case True
  Case Dir$(dbFileName_) = ""
    MsgBox "データベースファイルを指定してください"
  Case dbTableName_ = ""
    MsgBox "テーブル名を指定してください"
  Case Else
    If dbTrans_ <> transStatus Then
      If transStatus Then
        adoCn.BeginTrans
      Else
        adoCn.CommitTrans
      End If
      dbTrans_ = transStatus
    End If
  End Select
End Property

'トランザクション状態を取得します
Public Property Get dbTrans() As Boolean
  dbTrans = dbTrans_
End Property

'Excelデータベースにレコードを追加します
Public Sub AddRecord(recordData() As Variant)
  If Not dbTrans_ Then Me.dbTrans = True
  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

まずは試運転

　それでは少し動かしてみます。折角範囲指定出来るようになったので試してみましょう！！まず、上記クラスモジュールを実装したExcelファイルを用意します。空のシートモジュールには以下のコードを入力してください。ファイル"データ.xlsx"のシート"sheet1"の範囲"B2:F5"をテーブルとして指定しています。

Option Explicit

'シート範囲指定のテーブルにデータを追加する
Private Sub AddDataToRAngeTable()
Dim recordData() As Variant
  Dim db As clsExcelDbase
  Set db = New clsExcelDbase
  db.dbFileName = ThisWorkbook.Path & "\データ.xlsx"
  db.dbTableName = "Sheet1$B2:F5"
  recordData() = Array(Format$(Now, "YYYY/MM/DD"), "青山一郎", "男性", "AB", 30)
  db.AddRecord recordData()
End Sub

このファイルと同じフォルダにファイル"データ.xlsx"を作ります。シートの中身は以下の様にして保存しておきましょう。