ExcelでRDB（リレーショナルデータベース）を操作してみようという連載のその18です。前回の記事はこちらです。
今回もクラスモジュールの見直し
前回まででAccessファイル確認ツールが完了したと思ったのですが、クラスを修正していたらもう少し直したくなりました（笑）。
そこで、もう少しだけクラスを修正してみようと思います。クラスをちゃんと仕上げておくと、その他のツールを作るときも楽になりますからね！！
今回の修正点
修正点は以下の通りです。今回はメソッドの変更はありません。
ADOXの取り込み
今までのクラスはADOだけを使っていて、ADOXを使った機能（キー情報の取得）はシートモジュールに記述していました。でも、これだと中途半端です。ADOXも取り込むことでツール作成も楽になります。
キー情報のプロパティー
上で取り込んだADOXを使って、テーブルが決まった時にキー情報を取得してプロパティーで確認できるようにしました。また、キー情報が外部キーの場合、接続先のテーブル名も取得してプロパティーで確認できるようにしました。これでデータベース全体の構成が把握できます！！
テーブルリストプロパティー
同じくADOXを使って、構成するテーブルのリストも取得してプロパティーで確認できるようにしました。データベースファイルが決まれば自動的に決まる内容なんで、設定と同時に読込んでいけば便利です。
テーブルの変更
今まではテーブルプロパティーを設定すると、変更ができませんでした。でも、よくよく考えたら変更できた方が便利ですよね。テーブルの変更もできるようにしました。今回のツールでは使っていませんが、いずれ役に立つと思います。
ソース―コード
そして、ソースコードは以下の様になりました。長くなりますが、機能のわりにコンパクトにできたと思います。
Option Explicit
'Accessファイルのデータベースコントロールのクラスです
Private dbFileName_ As String 'データベースファイル名
Private dbTableList_() As Variant 'テーブルリスト
Private dbTrans_ As Boolean 'トランザクション状態
Private dbTableName_ As String 'テーブル名
Private dbFieldList_() As Variant 'フィールドリスト
Private dbFieldType_() As Variant 'フィールドタイプ
Private dbKeyType_() As Variant 'キータイプ
Private dbRelatedTable_() As Variant 'リレーションテーブル
Private adoCn As New ADODB.Connection
Private adoRs As New ADODB.Recordset
Private adoSelectRs As New ADODB.Recordset
Private catalogObject As New ADOX.Catalog
'初期化
Private Sub Class_Initialize()
adoCn.Provider = "Microsoft.ACE.OLEDB.12.0"
adoRs.CursorLocation = adUseClient
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)
Dim tableObject As Object
Dim i As Long
Select Case True
Case dbFileName_ <> ""
MsgBox "ファイル名は途中で変更できません"
Case Dir$(fileName) = ""
MsgBox "ファイルが見つかりません"
Case Else
adoCn.Open fileName
dbFileName_ = fileName
'テーブルリストを取得します
catalogObject.ActiveConnection = _
"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fileName
For Each tableObject In catalogObject.Tables
If tableObject.Type = "TABLE" Then
ReDim Preserve dbTableList_(i)
dbTableList_(i) = tableObject.Name
i = i + 1
End If
Next
End Select
End Property
'ファイル名を取得します
Public Property Get dbFileName() As String
dbFileName = dbFileName_
End Property
'テーブル名を設定します
Public Property Let dbTableName(ByVal tableName As String)
Dim keyObject As Object
Dim columnObject As Object
Dim i As Long
If Dir$(dbFileName_) = "" Then
MsgBox "データベースファイルを指定してください"
Exit Property
End If
'テーブル変更時の処理
If dbTableName_ <> "" Then
Me.dbTrans = False
If adoRs.State = adStateOpen Then adoRs.Close
If adoSelectRs.State = adStateOpen Then adoSelectRs.Close
End If
'レコードセット部ジェクトを開きます
adoRs.Open tableName, adoCn, adOpenKeyset, adLockOptimistic
dbTableName_ = tableName
'フィールドリストを設定します
ReDim dbFieldList_(adoRs.Fields.Count - 1)
ReDim dbFieldType_(adoRs.Fields.Count - 1)
For i = 0 To adoRs.Fields.Count - 1
dbFieldList_(i) = adoRs.Fields(i).Name
dbFieldType_(i) = adoRs.Fields(i).Type
Next
'キー情報を取得します
ReDim dbKeyType_(adoRs.Fields.Count - 1)
ReDim dbRelatedTable_(adoRs.Fields.Count - 1)
For Each keyObject In catalogObject.Tables(tableName).Keys
For Each columnObject In keyObject.Columns
For i = 0 To adoRs.Fields.Count - 1
If dbFieldList_(i) = columnObject.Name Then
dbKeyType_(i) = keyObject.Type
dbRelatedTable_(i) = keyObject.RelatedTable
Exit For
End If
Next
Next
Next
End Property
'テーブル名を取得します
Public Property Get dbTableName() As String
dbTableName = dbTableName_
End Property
'テーブルリストを取得します
Public Property Get dbTableList() As Variant
dbTableList = dbTableList_
End Property
'フィールドリストを取得します
Public Property Get dbFieldList() As Variant
dbFieldList = dbFieldList_
End Property
'フィールドタイプを取得します
Public Property Get dbFieldType() As Variant
dbFieldType = dbFieldType_
End Property
'キータイプを取得します
Public Property Get dbKeyType() As Variant
dbKeyType = dbKeyType_
End Property
'リレーションテーブルを取得します
Public Property Get dbRelatedTable() As Variant
dbRelatedTable = dbRelatedTable_
End Property
'トランザクション状態を設定します
Public Property Let dbTrans(transStatus As Boolean)
Select Case True
Case Dir$(dbFileName_) = ""
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
次回は使用例
いかがでしょうか？クラスを見直していくと、内容が洗練されてきて行く感じがします（実際には大したことない）。次回は、このクラスモジュールを使ってAccessファイル確認ツールを今度こそ完了させたいと思います。お楽しみに！！
