クラスモジュール作ってみた!!(Excelデータベースその8)

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

クラスモジュール

今回は、前回構想を練ったクラスをご紹介します。(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 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
End Sub
 
'終了処理
Private Sub Class_Terminate()
  If Err.Number <> 0 Then
    adoCn.RollbackTrans
    MsgBox "データベース接続に失敗しました"
  Else
    adoCn.CommitTrans
  End If
  adoRs.Close
  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

動かしてみよう!!

では、動かしてみましょう!!準備は以下になります。データベースとして使う-その6と同じ条件で実行しますがおさらいです。
1.任意フォルダにxlsmファイルを作成して空のクラスモジュールを作成。上記クラスのコードをコピーします。
2.上記ファイルのSheet1に下記サイトから静岡県データ(CSVファイル-約3700件)をコピーして下さい。
jusyo.jp
3.Sheet1には、以下のコードを配置してください。クラスモジュールからデータベースコントロールオブジェクトを作成して操作するコードです。

Option Explicit
'データベースコントロールクラスを使用してデータをコピーします。
Private Sub AddDataByClass()
Dim recordData() As Variant
Dim i As Long
  Debug.Print Now
  Dim db As clsExcelDbase
  Set db = New clsExcelDbase
  db.dbFileName = ThisWorkbook.Path & "\Sizuoka.xlsx"
  db.dbTableName = "sizuoka"

  i = 2
  Do While Me.Cells(i, 1) <> ""
    recordData() = Range(Me.Cells(i, 1), Me.Cells(i, 22))
    recordData() = WorksheetFunction.Transpose(WorksheetFunction.Transpose(recordData))
    db.AddRecord recordData()
    i = i + 1
  Loop
  Debug.Print Now
End Sub

4.コピー先のファイル『Sizuoka.xlsx』を同じフォルダに作成します。シート名は『sizuoka』としてシートの1行目にはフィールド名のみ入力しておきます。

この状態で、Sheet1のAddDataByClassを実行してみましょう。結果は、……約3秒!!。爆速です!!
やっぱり、レコードごとにデータベース接続ON/OFFしなければデータベースの圧勝です!!
クラスモジュールはちょっと長めになっちゃいましたけれど、一度作ってしまうと色々応用がきくんですよ!!

と、いう訳で次回はクラスの詳細解説をします。お楽しみに!!
hirocom777.hatenadiary.org
ExcelVBA-Excelファイルをデータベースとして使う連載はコチラからどうぞ!!