Accessデータベースを作ってみる(ExcelでRDBその4)

ExcelでRDB（リレーショナルデータベース）を操作してみようという連載のその4です。前回の記事はこちらです。

hirocom777.hatenadiary.org

簡単なデータベースシステムを作ってみる

　Accessファイルも作れたことだし、簡単なデータベースシステムを作ってみようと思います。この前の連載でExcelファイルを使ったデータベースシステムを作りましたが、そのときにデータベースを操作できる簡単なクラスモジュールを作りました。今回は、そのデータベースシステムとクラスモジュールをAccessファイル向けに改造してみます。改造したクラスモジュールで作ったサンプルツールを以下に置きますので参考にしてください。

04_Accessデータベースを作ってみる.zip - Google ドライブ

　改造と言っても、そんなに難しいところはないです。使っているのは同じADODB.Connectionオブジェクト。変更する点は主に
　・データベース接続文字列　"Microsoft.ACE.OLEDB.12.0"に変更
　・テーブルの指定方法　"["と"]"でくくる方法から直接指定に変更
　の2つです。
　また、レコードの削除機能とトランザクション機能を追加します。レコードの削除はExcelファイルのデータベースでは出来なかったので、ぜひ確認したいです。一度クラスを作ると、こういう具合に使いまわしができるところが便利ですね。

クラスモジュール

　クラスモジュールは以下のようになりました。あまり大きな変更点はありません。レコード削除のメソッドDeleteRecordが追加になりました。

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

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"
  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: 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

'トランザクション状態を設定します
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

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

'SQLのWHERE句指定でレコードを抽出して削除します。
Public Function DeleteRecord(cmdSql As String) As Long
  If Not dbTrans_ Then Me.dbTrans = True
  adoSelectRs.Open "SELECT * FROM " & dbTableName_ & "  WHERE " & cmdSql, adoCn, adOpenKeyset, adLockOptimistic
  If adoSelectRs.recordCount <> 1 Then
    MsgBox "レコードが一つに絞られていません"
  Else
    adoSelectRs.Delete
  End If
  adoSelectRs.Close
End Function

'SQLのWHERE句指定でレコードを抽出して指定フィールドのデータを取得します
Public Function GetFieldData(cmdSql As String, fieldName As String) As Variant
  adoSelectRs.Open "SELECT * FROM " & dbTableName_ & " WHERE " & cmdSql, adoCn
  Select Case adoSelectRs.recordCount
  Case 0
  Case 1
    GetFieldData = adoSelectRs.Fields(fieldName).Value
  Case Else
    MsgBox "レコードが一つに絞られていません"
  End Select
  adoSelectRs.Close
End Function

基本的な構造はExcelファイルデータベースの連載で作成したものと変わりません。コードの解説については以下を参考にしてください。
その8：クラスモジュール作ってみた！！
その9：クラスモジュールの解説
その10：検索機能を追加する！
その11：更に実用的なクラスモジュールへ！

レコードを削除するメソッドDeleteRecordは、指定されたSQLコマンドでレコードが一つに絞られた時に該当するレコードを削除します。

サンプルツールの使い方

この記事の最初に置いてあるサンプルツールをダウンロードして解凍してください。解凍したフォルダ内の"04_Accessデータベースを作ってみる.xlsm"をマクロを有効にして開くと、同じフォルダ内にある"名簿.accdb"の内容を表示します。ID欄（黄色いセル）に削除したいレコードのID番号を入力して削除ボタンを押すと、指定されたレコードを削除します。その他の使用方法については、同梱の"ReadMe.txt"を参照してください。

別なアプローチも考えてみます。

　とりあえずAccessファイルのデータベースシステムが出来ました。でも、これはレコード削除機能を追加してファイル形式を変えただけです。次回以降は、別なアプローチからAccessファイルの操作が出来ないか考えてみます！！
hirocom777.hatenadiary.org

ExcelVBAでAccessファイルを操作する連載はコチラから