検索機能を追加する！(Excelデータベースその10)

VBA

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

メソッドを追加

折角作成したクラスモジュールですが、今のところ出来ることはデータの追加だけ。もっとほかの機能も盛り込みたいところです。簡単に機能追加できるのはクラスの良いところ(だと勝手に思っている)ですからね。さて、どういう機能を追加しましょうか・・・

検索機能

　とりあえず、SQLを使った検索機能をつけましょう。その3で作ったプロシージャを参考に作ればいいですかね。以下のようなコードでした。

Public Function SelectRecord(strFileName As String, strSQL As String, Optional rngRange As Range = Nothing) As Long
On Error GoTo HrrorHandler
  Dim adoCn As Object
  Set adoCn = CreateObject("ADODB.Connection")
  
  With adoCn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .Properties("Extended Properties") = "Excel 12.0"
    .Open strFileName
  End With
  
  Dim adoRs As Object
  Set adoRs = CreateObject("ADODB.Recordset")
  adoRs.CursorLocation = adUseClient
  
  adoRs.Open strSQL, adoCn
  
  If Not rngRange Is Nothing Then rngRange.CopyFromRecordset adoRs
  SelectRecord = adoRs.RecordCount
  
  adoRs.Close
  adoCn.Close

HrrorHandler:
  If Err.Number <> 0 Then MsgBox "データベース接続に失敗しました"

End Function

う、このプロシージャでは Recordsetオブジェクトを開く際にSQLコマンドを指定していますね。前回作ったクラスモジュールでは初期化(Class_Initialize)時に Recordsetオブジェクトを開いてしまっています。これではSQLコマンドが指定できません。困りましたね・・・

Recordsetオブジェクトを追加する

そこで、検索用のRecordsetオブジェクトを追加しようと思います。具体的な変更内容は以下の通りです。
・検索用のRecordsetオブジェクトを追加
・初期化(Class_Initialize)時にCreateObject("ADODB.Recordset")をセット
・検索メソッドを追加する。
・検索メソッド内でSQL文とConnectionオブジェクトを指定してオープンする

検索メソッドでは、SQL文とConnectionオブジェクトを指定してオープンします。引数に設定するSQLコマンドですがテーブル名はクラスモジュールのプロパティーとして設定してあるのでWHERE句の後のみとします。また、先のプロシージャにあった指定したたRangeを起点に取得したRecordsetを表示できる機能も残しておきましょう。

変更後のクラスモジュール

と、言う訳で変更後のクラスモジュールは以下になります。（2021/1/11修正しました）

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
    If dbTableName_ <> "" Then adoCn.RollbackTrans
  Else
    adoCn.CommitTrans
  End If
  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
    adoCn.BeginTrans
    'フィールドリストを取得します
    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

'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

動かしてみる

それでは動かしてみましょう。まず、上記クラスモジュールを実装したExcelファイルを用意します。からのシートモジュールには以下のコードを入力してください。

Option Explicit

'zenkoku.xlsxから静岡県のデータを取り出す(ADO_Class版)
Sub ADO_Class_Test()
Dim sqlCmd As String
  Debug.Print Now
  Dim db As clsExcelDbase
  Set db = New clsExcelDbase
  db.dbFileName = ThisWorkbook.Path & "\zenkoku.xlsx"
  db.dbTableName = "zenkoku"
  
  Me.Range(Me.Range("A1"), Me.Range("A1").Offset(0, UBound(db.dbFieldList))) = db.dbFieldList
    
  sqlCmd = "都道府県 = '静岡県' ORDER BY 郵便番号 ASC;"

  db.SelectRecord sqlCmd, Me.Range("A2")
  Debug.Print Now
End Sub

このファイルと同じフォルダにその5で使用したzenkoku.xlsxファイルを配置してADO_Class_Testを実行してみてください。ちなみに、今回は郵便番号でソートしています。
hirocom777.hatenadiary.org

郵便番号でソートされた静岡県のデータがシートに表示されたと思います。大分実用的になってきたんじゃないでしょうか？

次回は、クラスモジュールをさらに実用的に改善していきます。お楽しみに！！
hirocom777.hatenadiary.org

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