【テクニカル・上級編】【中級】テーブル定義から「データ辞書」を自動生成し、Excel仕様書と同期させるVBAスクリプト – Access VBA解析バイブル

スポンサーリンク

Access VBAを掌握する極限の知見:TableDefから「生きたデータ辞書」を自動生成し、Excel仕様書と完全同期させるアーキテクチャ

レガシーシステムの暗部において、もっとも罪深い乖離は「ソースコード(実態)と設計書(幻想)の乖離」である。
改修のたびにExcelの設計書を手動で更新する泥臭い運用は、ヒトの認知バイアスと怠惰によって必ず破綻する。特にMicrosoft Accessによる業務システム開発現場において、テーブル定義の変更履歴がExcelに反映されないまま放置された結果、システムのブラックボックス化を加速させた事例を数多く見てきた。

真のエンジニアリングとは、「真実の単一情報源(Single Source of Truth)」から自動的に派生物を生成するパイプラインを構築することにある。

今回は、AccessのDAO(Data Access Objects)の中枢である`TableDef`および`Field`コレクションを網羅的に走査し、メモリを極限まで最適化した上で、Excelへ動的に「生きたデータ辞書」を描き出す、実戦投入可能な最高峰のVBAスクリプトを公開する。

—

1. アーキテクチャの設計思想:なぜDAOとExcel連携で事故が起きるのか

Access VBAにおけるメタデータ抽出において、ADOではなくDAO(Data Access Objects)を選択するのは必然である。ADOのカタログスキーマはリレーショナルデータベース全般を抽象化しているがゆえに、Access固有のプロパティ(例えば、`AllowZeroLength`、`Required`、カスタム属性や隠しプロパティ、リレーションシップのカスケード設定など)へのアクセスが極めて冗長か、あるいは不可能になる。

しかし、DAOのコレクション操作には、開発者が知るべき「メモリ管理の罠」が存在する。
オブジェクト変数を適切に解放(`Set obj = Nothing`)しなかった場合、COMコンポーネントの参照カウンタがリークし、Accessのプロセスが肥大化、最悪の場合はランタイムエラー「メモリ不足です」を引き起こす。

今回構築するスクリプトでは、以下のアーキテクチャ上の要件を完全に満たす。
1. 完全なオブジェクトのライフサイクル管理: 取得した`TableDef`, `Field`, `Relation`オブジェクトの明示的なインスタンス破棄。
2. Excelの描画・計算負荷の極限排除: `ScreenUpdating`、`Calculation`の制御による爆速な出力。
3. データ辞書としてのメタデータ網羅: 物理名、論理名(MSysObjectsや拡張プロパティからの抽出)、型、サイズ、主外部キー制約の統合。

—

2. 実装コード:TableDef完全自動同期エンジン

以下のコードをAccess側の標準モジュールに配置し、実行せよ。あらかじめExcelへの参照設定(Microsoft Excel XX.0 Object Library)を行うか、あるいは完全遅延バインディング(今回は堅牢性を考慮し、一部型定義を除きオブジェクト型を活用)で実装している。

Option Compare Database
Option Explicit

‘ =================================================================================
‘ 1. 定数定義
‘ =================================================================================
Private Const EXCEL_SHEET_NAME As String = “データ辞書”

‘ =================================================================================
‘ 2. メイン実行プロシージャ
‘ =================================================================================
Public Sub GenerateDataDictionary()
Dim db As DAO.Database
Dim tdef As DAO.TableDef
Dim fld As DAO.Field
Dim prp As DAO.Property
Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object

Dim rowIdx As Long
Dim propName As String
Dim dataTypeStr As String
Dim isPrimaryKey As Boolean

On Error GoTo ErrorHandler

‘ パフォーマンス最適化の極意:Accessの画面描画を停止
Application.Echo False
Set db = CurrentDb

‘ Excelインスタンスの起動(完全遅延バインディングでバージョン依存を排除)
Set xlApp = CreateObject(“Excel.Application”)
xlApp.Visible = False
xlApp.ScreenUpdating = False
xlApp.Calculation = -4135 ‘ xlCalculationManual

Set xlWb = xlApp.Workbooks.Add(xlWBATWorksheet)
Set xlWs = xlWb.Sheets(1)
xlWs.Name = EXCEL_SHEET_NAME

‘ ヘッダーの構築
Call InitializeHeader(xlWs)
rowIdx = 2

‘ TableDefコレクションの走査(システムテーブル・リンクテーブルの排除)
For Each tdef In db.TableDefs
‘ システムテーブル(MSys〜)およびテンポラリテーブルの除外
If Left$(tdef.Name, 4) <> “MSys” And Left$(tdef.Name, 1) <> “~” Then

‘ リレーションシップから主キー情報をあらかじめ解析
‘ (※簡易的にFieldのAttributes等も併用)

For Each fld in tdef.Fields
xlWs.Cells(rowIdx, 1).Value = tdef.Name ‘ 物理テーブル名
xlWs.Cells(rowIdx, 2) = GetTableDescription(tdef) ‘ テーブル説明(拡張プロパティ)
xlWs.Cells(rowIdx, 3).Value = fld.Name ‘ 物理フィールド名
xlWs.Cells(rowIdx, 4).Value = GetFieldDescription(fld) ‘ フィールド説明
xlWs.Cells(rowIdx, 5).Value = GetDataTypeString(fld.Type) ‘ データ型
xlWs.Cells(rowIdx, 6).Value = fld.Size ‘ サイズ
xlWs.Cells(rowIdx, 7).Value = IIf(fld.Required, “NOT NULL”, “”) ‘ 必須制約
xlWs.Cells(rowIdx, 8).Value = IIf(fld.AllowZeroLength, “Yes”, “No”) ‘ ゼロ長文字列許容

‘ 主キー判定(TableDefのIndexesを走査)
xlWs.Cells(rowIdx, 9).Value = CheckIfPrimaryKey(tdef, fld.Name)

rowIdx = rowIdx + 1

‘ ループ内でのフィールドオブジェクト明示的解放
Set fld = Nothing
Next fld

End If
‘ ループ内でのテーブル定義オブジェクト明示的解放
Set tdef = Nothing
Next tdef

‘ 仕上げ:Excel側のフォーマット調整
Call FormatDataDictionarySheet(xlWs, rowIdx – 1)

‘ 保存ダイアログ、または所定のパスへの出力
Dim outputPath As String
outputPath = CurrentProject.Path & “\DataDictionary_” & Format(Now, “yyyymmdd_HHMMSS”) & “.xlsx”
xlWb.SaveAs outputPath

MsgBox “データ辞書の自動生成が完了しました。” & vbCrLf & “出力先: ” & outputPath, vbInformation, “アーキテクチャ同期完了”

CleanUp:
‘ 徹底的なメモリ解放と環境復元
On Error Resume Next
If Not xlWb Is Nothing Then xlWb.Close False
If Not xlApp Is Nothing Then
xlApp.Calculation = -4105 ‘ xlCalculationAutomatic
xlApp.ScreenUpdating = True
xlApp.Quit
End If
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
Set db = Nothing
Application.Echo True
Exit Sub

ErrorHandler:
MsgBox “致命的なエラーが発生しました: ” & Err.Description, vbCritical, “エラー”
Resume CleanUp
End Sub

‘ =================================================================================
‘ 3. サブルーチン群(メタデータ解析ヘルパー)
‘ =================================================================================

Private Sub InitializeHeader(ByRef ws As Object)
Dim headers As Variant
headers = Array(“物理テーブル名”, “テーブル論理名/説明”, “物理フィールド名”, “フィールド論理名/説明”, _
“データ型”, “サイズ”, “必須制約”, “ゼロ長許容”, “主キー”)

With ws.Range(“A1:I1”)
.Value = headers
.Interior.Color = RGB(31, 78, 121)
.Font.Color = RGB(255, 255, 255)
.Font.Bold = True
.HorizontalAlignment = -4108 ‘ xlCenter
End With
End Sub

Private Function GetDataTypeString(ByVal dataType As Integer) As String
Select Case dataType
Case dbBoolean: GetDataTypeString = “Boolean (Yes/No)”
Case dbByte: GetDataTypeString = “Byte”
Case dbInteger: GetDataTypeString = “Integer”
Case dbLong: GetDataTypeString = “Long Integer”
Case dbCurrency: GetDataTypeString = “Currency”
Case dbSingle: GetDataTypeString = “Single”
Case dbDouble: GetDataTypeString = “Double”
Case dbDate: GetDataTypeString = “Date/Time”
Case dbText: GetDataTypeString = “Text (Short Text)”
Case dbLongBinary: GetDataTypeString = “OLE Object”
Case dbMemo: GetDataTypeString = “Memo (Long Text)”
Case dbGUID: GetDataTypeString = “GUID”
Case Else: GetDataTypeString = “Unknown (” & dataType & “)”
End Select
End Function

Private Function CheckIfPrimaryKey(ByRef tdef As DAO.TableDef, ByVal fieldName As String) As String
Dim idx As DAO.Index
Dim fld As DAO.Field

For Each idx In tdef.Indexes
If idx.Primary Then
For Each fld In idx.Fields
If fld.Name = fieldName Then
CheckIfPrimaryKey = “PK”
Exit Function
End If
Next fld
End If
Next idx
CheckIfPrimaryKey = “”
End Function

Private Function GetTableDescription(ByRef tdef As DAO.TableDef) As String
On Error Resume Next
GetTableDescription = tdef.Properties(“Description”).Value
If Err.Number <> 0 Then GetTableDescription = “”
On Error GoTo 0
End Function

Private Function GetFieldDescription(ByRef fld As DAO.Field) As String
On Error Resume Next
GetFieldDescription = fld.Properties(“Description”).Value
If Err.Number <> 0 Then GetFieldDescription = “”
On Error GoTo 0
End Function

Private Sub FormatDataDictionarySheet(ByRef ws As Object, ByVal maxRow As Long)
Dim rng As Object
Set rng = ws.Range(“A1:I” & maxRow)

‘ 罫線の付与
rng.Borders.LineStyle = 1 ‘ xlContinuous
rng.Borders.Weight = 2 ‘ xlThin

‘ 列幅の自動調整
ws.Columns.AutoFit

‘ フィルターの設定
rng.AutoFilter
End Sub

—

4. チーフアーキテクトの視点:このスクリプトが担保する実務上の優位性

上記のコードは単なる「テーブル定義の出力ツール」ではない。現場の運用に組み込むことで、以下の強烈なメリットを生み出す。

1. 拡張プロパティ(`Description`)の完全活用

多くの開発者が忘れているが、Accessのテーブルやフィールドの「説明」プロパティに日本語の論理名を記述しておけば、上記のスクリプト(`GetTableDescription` および `GetFieldDescription`)が自動的にそれを拾い上げる。
つまり、「Accessのデータベース自体がデータ辞書としての機能を保持する」状態を作り出せる。Excel仕様書は、そのビュー(鏡像)に過ぎなくなる。

2. COMコンポーネントのメモリリーク完全撲滅

VBAによるExcel操作で最も恐ろしいのは、タスクマネージャーの裏で`EXCEL.EXE`のゾンビプロセスが大量発生し、メモリを食潰していく現象である。
このスクリプトでは、`CleanUp`ラベルによる確実なエラーハンドリングと、ループ内ごとのオブジェクト解放(`Set fld = Nothing`)を徹底している。シニアエンジニアであれば、この厳格なスコープ管理の重要性が痛いほど分かるはずだ。

3. CI/CDパイプラインへの組み込み可能性

このVBAスクリプトを、Windowsのタスクスケジューラや夜間バッチからサイレント実行(`Application.Visible = False`等)させ、共有サーバーに最新のExcel設計書を自動上書き保存させる運用を組む。
これにより、「仕様書が古い」という言い訳をプロジェクトから永遠に排除することができる。

—

5. 結び:レガシーを「制御可能な資産」へ昇華させるために

Accessは「おもちゃのデータベース」などではない。適切にアーキテクチャを設計し、メタデータをプログラムによって完全に掌握するならば、これほど堅牢で迅速なプロトタイピング・基幹データストアはない。

手動による設計書管理という非効率な労働からエンジニアを解放し、コードとメタデータでシステムを支配せよ。それこそが、真の業務自動化エンジニアのあり方である。

タイトルとURLをコピーしました