なぜ、GUIによるテーブル設計は「負債」になるのか
多くのAccess開発プロジェクトにおいて、テーブル設計は「リレーションシップウィンドウ」や「テーブルのデザインビュー」といったGUI上で行われています。開発初期のフェーズでは、このビジュアルなアプローチは手軽で直感的に見えるでしょう。
しかし、システムが成長し、本番環境、ステージング環境、開発環境といったマルチ環境の同期が必要になった瞬間、この牧歌的な運用は牙を剥きます。
- 差分管理の崩壊: 誰が、いつ、どのカラムのデータ型を、どう変更したのかが追跡できない。Gitによるバージョン管理が効かないバイナリ（`.accdb`）の特性上、手動のスキーマ同期は必ずヒューマンエラーを引き起こします。
- 初期化・再構築の困難さ: テストデータをクリアしてクリーンな状態から結合テストを実行したい時、手動で作成したテーブル群やリレーションシップを安全に、かつ一瞬で再ビルドする手段がありません。
- メタデータの一元化不足: テーブルの定義情報、バリデーションルール、リレーションの連動削除属性などの「仕様」が、ドキュメント（Excel等）と実機データベースの双方に分散し、乖離していきます。
これらの課題を根本から解決するのが、「メタデータ駆動型開発（Metadata-Driven Development）」です。
テーブル、フィールド、インデックス、そしてリレーションシップに及ぶすべてのデータベーススキーマをテキスト形式のJSON定義ファイルに集約し、VBAからDAO（Data Access Objects）をミリ秒単位で直接操作して、スキーマを完全自動生成するフレームワークを構築します。これにより、スキーマ情報は完全に「コード（テキスト）」としてGit管理可能になり、Accessの起動時、あるいはビルド用関数を実行するだけで、寸分狂わぬデータベースが瞬時に構築されるようになります。
—
アーキテクチャ設計：DAOオブジェクトモデルとJSONパースの極意
Access VBAでメタデータ駆動を実現するためには、以下の2つの技術的障壁をクリアする必要があります。
1. 外部依存（サードパーティ製ライブラリ）の排除とJSONのパース
2. DAOオブジェクトの厳密なライフサイクル管理
1. 外部依存なしでJSONをパースする「htmlfile」ハック
VBAには標準でJSONデコーダーが搭載されていません。外部の `VBA-JSON` ライブラリ（スクリプトコントロール等を利用するもの）を導入するのが一般的ですが、64bit版Access（Office）環境では `MSScriptControl.ScriptControl` が動作しないという致命的な「64bitの壁」が存在します。
この問題を解決するため、本フレームワークでは Windows標準の `htmlfile` オブジェクト（`mshtml.dll`）の JavaScriptエンジンをVBAのメモリ空間にロードし、完全な64bit/32bit互換を保ったまま超高速にJSONをパースする手法を採用します。
2. DAOオブジェクトの厳密な生成・破棄順序
データベーススキーマを再構築する際、オブジェクトの操作順序を誤ると、Accessエンジン（ACE）は即座にランタイムエラー（「オブジェクトは他のオブジェクトによって使用されています」「依存関係が存在します」等）を吐いて停止します。
再構築処理は、以下の「破壊と創造のシーケンス」を厳密に遵守しなければなりません。
[既存データベース]
│
▼ (1) 既存リレーションシップの全削除（依存関係の解消）
│
▼ (2) 既存テーブルの全削除
│
[完全なクリーン状態]
│
▼ (3) テーブルの生成 ＆ フィールド（データ型・サイズ・必須属性）の追加
│
▼ (4) 主キー（Primary Key）インデックスの作成
│
▼ (5) リレーションシップ（一対多、カスケード更新・削除）の再設定
特に「リレーションシップ」は、親テーブルと子テーブルの双方にインデックスが存在していることを要求するため、すべてのテーブルと主キーが作成し終わった後でなければ追加できないという順序依存性があります。この依存関係をVBAコード内で完全に制御します。
—
完全自動生成フレームワーク：プロダクションコード
以下に、実務でそのまま利用できる、堅牢でモジュール化されたプロダクションコードを示します。標準モジュール（例：`mod_SchemaBuilder`）にコピー＆ペーストして使用してください。
参照設定
このコードは、レイトバインディングを採用しているため追加の参照設定は不要ですが、DAOの操作を行うため 「Microsoft Office 16.0 Access database engine Object Library」（通常は標準で参照されています）が有効であることを確認してください。
Option Compare Database
Option Explicit
‘ ==============================================================================
‘ 【メタデータ駆動型スキーマジェネレーター】
‘ 開発・運用におけるデータベーススキーマの完全自動生成を担当します。
‘ ==============================================================================
Private Const MODULE_NAME As String = “mod_SchemaBuilder”
”’
”’
”’ JSON定義ファイルの絶対パス
Public Sub RebuildDatabaseSchema(ByVal jsonFilePath As String)
On Error GoTo ErrorHandler
Dim db As DAO.Database
Set db = CurrentDb()
‘ 1. JSONファイルの読み込み
Dim jsonString As String
jsonString = ReadTextFileUTF8(jsonFilePath)
‘ 2. JSONパース用エンジンの初期化 (htmlfileハック)
Dim html As Object
Set html = CreateObject(“htmlfile”)
Dim jsonObject As Object
‘ JavaScriptのJSON.parseを実行
html.parentWindow.execScript “function parseJson(str) { return JSON.parse(str); }”, “JScript”
Set jsonObject = html.parentWindow.parseJson(jsonString)
Debug.Print “— スキーマ再構築プロセス 開始 —”
‘ 3. 依存関係のクリーンアップ（リレーション -> テーブルの順で削除）
Call DropAllRelations(db)
Call DropAllTargetTables(db, jsonObject.Tables)
‘ 4. テーブルおよびフィールドの作成
Call CreateTables(db, jsonObject.Tables)
‘ 5. リレーションシップの作成（すべてのテーブルと主キーが存在する状態で実行）
If Not IsUndefined(jsonObject, “Relations”) Then
Call CreateRelations(db, jsonObject.Relations)
End If
Debug.Print “— スキーマ再構築プロセス 正常終了 —”
MsgBox “データベーススキーマの再構築が完了しました。”, vbInformation, “成功”
ExitProcedure:
Set db = Nothing
Set html = Nothing
Exit Sub
ErrorHandler:
Dim errNum As Long: errNum = Err.Number
Dim errDesc As String: errDesc = Err.Description
Debug.Print “【FATAL ERROR】 ” & MODULE_NAME & “.RebuildDatabaseSchema: ” & errDesc
MsgBox “スキーマ再構築中に致命的なエラーが発生しました。” & vbCrLf & _
“エラー番号: ” & errNum & vbCrLf & errDesc, vbCritical, “エラー発生”
Resume ExitProcedure
End Sub
”’
”’
Private Sub DropAllRelations(ByRef db As DAO.Database)
Dim i As Long
‘ コレクションの削除は常に逆順ループで行うのが鉄則（インデックスのズレを防止）
For i = db.Relations.Count – 1 To 0 Step -1
Dim relName As String
relName = db.Relations(i).Name
‘ システム定義のリレーションシップ（MSys）以外を削除
If Not (relName Like “MSys”) Then
Debug.Print “Relation削除: ” & relName
db.Relations.Delete relName
End If
Next i
End Sub
”’
”’
Private Sub DropAllTargetTables(ByRef db As DAO.Database, ByVal tablesDef As Object)
Dim i As Long
Dim tableName As String
‘ JSON配列の要素数を取得するためのループ
Dim tableDef As Object
For i = 0 To GetJavaScriptArrayLength(tablesDef) – 1
Set tableDef = CallByName(tablesDef, CStr(i), VbMethod)
tableName = tableDef.Name
‘ テーブルが存在する場合のみ削除
If TableExists(db, tableName) Then
Debug.Print “Table削除: ” & tableName
db.TableDefs.Delete tableName
End If
Next i
End Sub
”’
”’
Private Sub CreateTables(ByRef db As DAO.Database, ByVal tablesDef As Object)
Dim i As Long, j As Long
Dim tableDefObj As Object
Dim fieldsDef As Object
Dim fieldDef As Object
Dim tblLength As Long: tblLength = GetJavaScriptArrayLength(tablesDef)
For i = 0 To tblLength – 1
Set tableDefObj = CallByName(tablesDef, CStr(i), VbMethod)
Dim tableName As String: tableName = tableDefObj.Name
Debug.Print “Table作成: ” & tableName
Dim newTable As DAO.TableDef
Set newTable = db.CreateTableDef(tableName)
Set fieldsDef = tableDefObj.Fields
Dim fldLength As Long: fldLength = GetJavaScriptArrayLength(fieldsDef)
‘ フィールドの作成と追加
For j = 0 To fldLength – 1
Set fieldDef = CallByName(fieldsDef, CStr(j), VbMethod)
Dim fldName As String: fldName = fieldDef.Name
Dim fldType As Long: fldType = MapDataType(fieldDef.Type)
Dim fldSize As Long: fldSize = 0
‘ テキスト型（dbText）の場合はサイズ指定が必須。未指定時はデフォルト255文字
If fldType = dbText Then
If HasProperty(fieldDef, “Size”) Then
fldSize = fieldDef.Size
Else
fldSize = 255
End If
End If
Dim newField As DAO.Field
If fldSize > 0 Then
Set newField = newTable.CreateField(fldName, fldType, fldSize)
Else
Set newField = newTable.CreateField(fldName, fldType)
End If
‘ 必須（Required）属性の制御
If HasProperty(fieldDef, “Required”) Then
newField.Required = CBool(fieldDef.Required)
End If
newTable.Fields.Append newField
Next j
‘ テーブルをデータベースに登録（この時点で物理的にテーブルが作られる）
db.TableDefs.Append newTable
‘ 主キー（Primary Key）の作成
‘ DAOでは、主キーは「フィールドの属性」ではなく「インデックスオブジェクト」として定義する
For j = 0 To fldLength – 1
Set fieldDef = CallByName(fieldsDef, CStr(j), VbMethod)
If HasProperty(fieldDef, “PrimaryKey”) Then
If CBool(fieldDef.PrimaryKey) = True Then
Call CreatePrimaryKey(db, tableName, fieldDef.Name)
End If
End If
Next j
Next i
End Sub
”’
”’
Private Sub CreatePrimaryKey(ByRef db As DAO.Database, ByVal tableName As String, ByVal fieldName As String)
Dim tdf As DAO.TableDef
Set tdf = db.TableDefs(tableName)
‘ 主キー用のインデックスオブジェクトを作成
Dim idx As DAO.Index
Set idx = tdf.CreateIndex(“PrimaryKey”)
idx.Primary = True
idx.Unique = True
‘ インデックス対象のフィールドを登録
Dim idxField As DAO.Field
Set idxField = idx.CreateField(fieldName)
idx.Fields.Append idxField
tdf.Indexes.Append idx
Debug.Print ” 主キー設定: ” & fieldName
End Sub
”’
”’
Private Sub CreateRelations(ByRef db As DAO.Database, ByVal relationsDef As Object)
Dim i As Long, j As Long
Dim relLength As Long: relLength = GetJavaScriptArrayLength(relationsDef)
Dim relDef As Object
For i = 0 To relLength – 1
Set relDef = CallByName(relationsDef, CStr(i), VbMethod)
Dim relName As String: relName = relDef.Name
Dim primaryTable As String: primaryTable = relDef.Table
Dim foreignTable As String: foreignTable = relDef.ForeignTable
Debug.Print “Relation作成: ” & relName & ” (” & primaryTable & ” -> ” & foreignTable & “)”
Dim newRel As DAO.Relation
Set newRel = db.CreateRelation(relName, primaryTable, foreignTable)
‘ カスケード更新・削除属性（Attributes）の設定
Dim attrib As Long: attrib = dbRelationLeft ‘ デフォルト
If HasProperty(relDef, “Attributes”) Then
Dim attrStr As String: attrStr = relDef.Attributes
If InStr(attrStr, “CascadeDelete”) > 0 Then
attrib = attrib Or dbRelationDeleteCascade
End If
If InStr(attrStr, “CascadeUpdate”) > 0 Then
attrib = attrib Or dbRelationUpdateCascade
End If
End If
newRel.Attributes = attrib
‘ リレーションを構成するフィールドマッピング
Dim fieldsDef As Object: Set fieldsDef = relDef.Fields
Dim fieldsLength As Long: fieldsLength = GetJavaScriptArrayLength(fieldsDef)
Dim fldDef As Object
For j = 0 To fieldsLength – 1
Set fldDef = CallByName(fieldsDef, CStr(j), VbMethod)
Dim fldName As String: fldName = fldDef.Name
Dim fldForeignName As String: fldForeignName = fldDef.ForeignName
Dim relField As DAO.Field
Set relField = newRel.CreateField(fldName)
relField.ForeignName = fldForeignName
newRel.Fields.Append relField
Next j
‘ リレーションシップをデータベースに追加
db.Relations.Append newRel
Next i
End Sub
‘ ==============================================================================
‘ ユーティリティ / ヘルパー関数群
‘ ==============================================================================
Private Function TableExists(ByRef db As DAO.Database, ByVal tableName As String) As Boolean
Dim tdf As DAO.TableDef
On Error Resume Next
Set tdf = db.TableDefs(tableName)
On Error GoTo 0
TableExists = Not (tdf Is Nothing)
End Function
Private Function MapDataType(ByVal typeString As String) As Long
Select Case LCase(typeString)
Case “long”, “autonumber”: MapDataType = dbLong
Case “text”: MapDataType = dbText
Case “memo”, “note”: MapDataType = dbMemo
Case “date”, “datetime”: MapDataType = dbDate
Case “currency”: MapDataType = dbCurrency
Case “boolean”, “yesno”: MapDataType = dbBoolean
Case “double”: MapDataType = dbDouble
Case “integer”: MapDataType = dbInteger
Case Else
Err.Raise 9999, MODULE_NAME & “.MapDataType”, “未サポートのデータ型です: ” & typeString
End Select
End Function
Private Function ReadTextFileUTF8(ByVal filePath As String) As String
Dim stream As Object
Set stream = CreateObject(“ADODB.Stream”)
stream.Type = 2 ‘ adTypeText
stream.Charset = “UTF-8”
stream.Open
stream.LoadFromFile filePath
ReadTextFileUTF8 = stream.ReadText
stream.Close
Set stream = Nothing
End Function
Private Function GetJavaScriptArrayLength(ByVal jsArray As Object) As Long
On Error GoTo ErrorHandler
GetJavaScriptArrayLength = CallByName(jsArray, “length”, VbGet)
Exit Function
ErrorHandler:
‘ 配列ではない場合、または空オブジェクトの場合は0を返す
GetJavaScriptArrayLength = 0
End Function
Private Function HasProperty(ByVal obj As Object, ByVal propName As String) As Boolean
On Error Resume Next
Dim val As Variant
val = CallByName(obj, propName, VbGet)
HasProperty = (Err.Number = 0)
On Error GoTo 0
End Function
Private Function IsUndefined(ByVal obj As Object, ByVal propName As String) As Boolean
On Error GoTo TrueLabel
Dim val As Variant
Set val = CallByName(obj, propName, VbGet)
IsUndefined = (val Is Nothing)
Exit Function
TrueLabel:
IsUndefined = True
End Function
—
スキーマ定義用JSONファイル（`schema.json`）の作成
上記のVBAスクリプトが読み込むJSON定義ファイルの構成例です。実務に即した「部門テーブル」と「社員テーブル」の1対多のリレーションシップ（連動削除付き）を定義します。
{
“Tables”: [
{
“Name”: “tbl_Departments”,
“Fields”: [
{ “Name”: “DepartmentID”, “Type”: “Long”, “PrimaryKey”: true },
{ “Name”: “DepartmentName”, “Type”: “Text”, “Size”: 100, “Required”: true }
]
},
{
“Name”: “tbl_Employees”,
“Fields”: [
{ “Name”: “EmployeeID”, “Type”: “Long”, “PrimaryKey”: true },
{ “Name”: “EmployeeName”, “Type”: “Text”, “Size”: 50, “Required”: true },
{ “Name”: “DepartmentID”, “Type”: “Long”, “Required”: true },
{ “Name”: “HireDate”, “Type”: “Date”, “Required”: false },
{ “Name”: “Salary”, “Type”: “Currency”, “Required”: false }
]
}
],
“Relations”: [
{
“Name”: “rel_Dept_Emp”,
“Table”: “tbl_Departments”,
“ForeignTable”: “tbl_Employees”,
“Attributes”: “CascadeDelete|CascadeUpdate”,
“Fields”: [
{ “Name”: “DepartmentID”, “ForeignName”: “DepartmentID” }
]
}
]
}
—
実行方法
イミディエイトウィンドウ、または標準モジュールの任意のテスト用関数から以下のように呼び出します。
Public Sub RunDatabaseBuild()
Dim path As String
‘ カレントデータベースと同一フォルダに置かれた “schema.json” を読み込む
path = CurrentProject.Path & “\schema.json”
Call RebuildDatabaseSchema(path)
End Sub
—
プロダクション運用における注意点と「極限の知見」
このメタデータ駆動型アーキテクチャを現場に適用し、実用に耐えうるものにするためには、以下の「運用設計」が不可欠です。
1. データの保護と「破壊的変更」のガード
本フレームワークは、指定されたテーブルを一度物理的に削除（Drop）してから再生成します。つまり、本番環境でこのスクリプトを不用意に実行すれば、既存のデータはすべて揮発します。
実務で運用する際は、必ず以下のガードレールを敷いてください。
- 環境識別フラグの実装: データベース内に `sys_Config` などの管理テーブルを用意するか、環境変数（あるいは `CurrentProject.Path` の文字列検知）を利用して、「本番環境（Production）」での実行要求に対しては強制的に例外を発生させ、処理を中断させるガードロジックをエントリーポイントの直後に記述します。
- 移行（Migration）スクリプトの分離: 既に本番データが入っているテーブルの定義変更（例：カラム追加）を行う場合は、本スクリプトによる全破壊ではなく、`ALTER TABLE` などのDDL（Data Definition Language）文を発行する、一方向のマイグレーションスクリプトに処理を委譲する設計にします。
2. 空き領域の肥大化と「最適化（Compact）」
Accessデータベース（ACEエンジン）は、オブジェクトの削除や再作成を繰り返すと、内部の空き領域（LVT領域など）が解放されず、バイナリファイルサイズが極端に肥大化（膨張）するという仕様上の弱点があります。
本スキーマジェネレーターの実行後は、必ず `Application.CompactRepair`（データベースの最適化と修復）を実行するように運用フローに組み込んでください。プログラムから別スレッド、あるいはAccess終了時に最適化をトリガーさせるコードを仕込むと完璧です。
3. オートナンバー（AutoNumber）の定義
Accessにおいて、オートナンバー型は独立したデータ型ではなく、「データ型は Long（長整数型）であり、かつ属性がオートナンバー（Counter）」という実装になっています。DAOでこれを厳密に定義する場合、フィールドオブジェクトを作成した直後に、`Field.Attributes = dbAutoIncrField` を設定する必要があります。自動生成をさらに拡張する際は、この属性処理を追加してください。
—
まとめ：メタデータ駆動がもたらすAccess開発のパラダイムシフト
JSON定義ファイルからテーブル構造を完全自動生成するこのアプローチは、Access開発を「古いレガシーな手法」から「モダンなソフトウェアエンジニアリング」へと引き上げるための強力な武器です。
- 仕様書＝コードの一貫性: JSONファイルを設計仕様書として定義しておけば、それ自体が正本となり、ドキュメントとシステムの実態の乖離がゼロになります。
- Gitフレンドリー: データベース構造の変更がすべてJSONテキストの差分（Diff）としてGit上に記録されるため、いつ、誰がスキーマを変更したのかが完全に可視化されます。
- 瞬時のテスト環境構築: テストを実行する直前にこのスクリプトを走らせるだけで、クリーンでリレーションの破綻していないデータベース環境がミリ秒単位で構築できます。
データベースオブジェクトのライフサイクルをDAOで正しく制御し、メタデータ駆動の恩恵を最大限に享受してください。あなたのチームの開発効率は、劇的に向上するはずです。
