Accessファイル確認ツール⑤(ExcelでRDBその19)

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

hirocom777.hatenadiary.org

修正したクラスの適用

前回は更なるクラスモジュールの修正を行いました。結構完成度上った感じです。

今回は修正したクラスモジュールを使用してAccessファイル確認ツールを機能アップしていきたいと思います。今回の内容を適用したツールを以下に置いておきますので、興味のある方はダウンロードしてみてください。

19_Accessファイル確認ツール⑤.zip - Google ドライブ

今回の修正点

今回の主な修正点は以下の2点です（その他にも軽微な修正があります）。

参照先テーブル表示の追加

まず、参照先テーブル表示の追加です。クラスモジュールで外部キーが設定されている場合、参照先テーブル名を取得できるようにしましたので、表示もしてみようと思います。カラムリストを表示するプロシージャは以下の様になりました。

'カラムリストを表示します
Private Sub DispColumnList(fileName As String, tableName As String)
Dim db As clsAccessDbase
Dim i As Long
On Error GoTo ErrorHandler
  '表示をクリアします
  Me.Range("TABLE_AREA").ClearContents
  Me.Range("A10").Activate
  Me.Range("TableName").Select
  'カラム情報を表示します
  Set db = New clsAccessDbase
  db.dbFileName = Me.Range("FileName").Text
  db.dbTableName = Me.Range("TableName").Text
  With Me.Range("columnList").Offset(1, 0)
    For i = 0 To UBound(db.dbFieldList)
      .Offset(i, -1) = i + 1
      .Offset(i, 0) = db.dbFieldList(i)
      .Offset(i, 1) = GetDataInfo(CLng(db.dbFieldType(i)))
      .Offset(i, 2) = GetKeyInfo(CLng(db.dbKeyType(i)))
      .Offset(i, 3) = db.dbRelatedTable(i)
    Next i
  End With
ErrorHandler:
  If Err.Number <> 0 Then MsgBox "テーブルエラーです"
End Sub

テーブル情報の表示順はカラムリスト、データ型、キー、参照先テーブルに変更しました。操作画面は以下の様になりました。

f:id:HiroCom777:20220408163604j:plain

キー情報が外部キーの場合は参照先テーブルが表示されます。これでAccessファイルの全体像がわかりやすくなったと思います。

テーブルリスト取得方法の変更

クラスモジュールでテーブルのリストをプロパティーとして取得できるようにしました。ですので本体側ではADOXを使ってテーブルリストを取得する必要が無くなりました。テーブルリストを表示する部分は以下の様になりました。

'Accessファイルの指定を実行します
Public Sub cmdFile_Click()
Dim db As New clsAccessDbase
Dim fileName As String
Dim fileFilter As String
Dim i As Long
  fileFilter = "Accessファイル(*.accdb),*.accdb"
  'ダイアログを表示してファイルを指定
  fileName = Application.GetOpenFilename(fileFilter)
  Me.ClearData
  'テーブルリストを表示します
  If fileName <> "False" Then
    Me.Range("FileName").Value = fileName
    db.dbFileName = fileName
    For i = 0 To UBound(db.dbTableList)
      Me.Range("TableList").Offset(i + 1, -1) = i + 1
      Me.Range("TableList").Offset(i + 1, 0) = db.dbTableList(i)
    Next
    Me.Range("TableName").Value = db.dbTableList(0)
  End If
End Sub

ADOXが表に出なくなった分スッキリしたと思います。やはりクラスモジュールを丁寧に作るとツール側の開発も、わかりやすくて楽になりますね。