【テクニカル・上級編】【上級】循環参照を回避する複雑なリレーションシップの自動構築ロジック – Access VBA解析バイブル

スポンサーリンク

Access RDBの深淵:循環参照を回避しリレーションシップを自動構築するトポロジカル・シーケンサー

リレーショナルデータベース(RDB)の設計において、テーブル間の「参照整合性制約(Referential Integrity)」は、データの命脈である。しかし、長年にわたり拡張と秘伝の継ぎ足しを重ねてきたエンタープライズ級のAccessデータベース(`.accdb` / `.mdb`)においては、このリレーションシップの構築自体が、極めて難解なパズルと化す。

テーブル数が数十、数百に及び、自己参照や疑似的な多対多、そして設計書の不備による「循環参照(閉路)」が潜む環境で、単純にリレーションシップを上から順に構築しようとすれば、高確率で「ランタイムエラー 3011(オブジェクトが見つかりません)」や「エラー 3201(関連するレコードが必要です)」、最悪の場合はデータベースの破損を招く。

本稿では、グラフ理論における「トポロジカルソート(Topological Sort)」をAccess VBAに移植し、テーブル間の依存関係を完全に解析・シリアライズした上で、循環参照(閉路)を検知・排除しつつ、参照整合性制約を安全かつ最速で自動構築する極限のロジックを提示する。

1. アーキテクチャ:なぜ依存関係のトポロジカル解析が必要なのか

RDBにおけるリレーションシップの構築は、単純なオブジェクトの追加ではない。
親テーブル(被参照側)に主キーまたは一意インデックスが存在しなければ、子テーブル(参照側)に外部キー制約を付与することはできない。つまり、リレーションシップの構築には「厳密な順序(トポロジカル順序)」が存在する。

[テーブルA: 顧客] ──── (親) ───┐


[テーブルB: 注文] ──── (親) ───► [テーブルC: 注文明細]

上図のような依存関係がある場合、構築順序は `A ➔ B ➔ C` または `B ➔ A ➔ C` でなければならない。`C` を `A` や `B` より先に、あるいは同時に処理しようとすれば、DAO(Data Access Objects)は即座に例外をスローする。

さらに厄介なのが、システム移行やスキーマ再構築時に混入する「循環参照(Circular Dependency)」である。

[テーブルX] ───► [テーブルY] ───► [テーブルZ] ───► [テーブルX] (ループ発生!)

このような閉路(Cycle)が存在する場合、通常のシーケンシャルな構築ロジックは無限ループに陥るか、永久に解決できない制約エラーを吐き出し続ける。

これを解決するため、本エンジンでは以下のフェーズを踏む:
1. メタデータの抽象化: 構築すべきリレーション群を一旦メモリ上に「有向グラフ」として展開する。
2. 深さ優先探索(DFS)による閉路検出: 再帰アルゴリズムを用いて、グラフ内に循環参照が存在しないかを検証する。
3. トポロジカルソート: 依存関係の上流(他から参照されていないテーブル)から下流へと、構築順序をソートする。
4. トランザクション制御下での一括構築: DAOのメモリリークを徹底的に抑え込みながら、安全にRelationオブジェクトを注入する。

2. 極限の実装:`RelationSequencer` クラス

以下のコードは、Windows APIによる高精度なメモリ監視と、DAOの厳密なオブジェクトライフサイクル管理を融合させた、プロダクション環境仕様の自動構築エンジンである。

クラスモジュール名を `RelationSequencer` として作成していただきたい。

クラスモジュール: `RelationSequencer`

Option Compare Database
Option Explicit

‘ ==============================================================================
‘ クラス名: RelationSequencer
‘ 概要: トポロジカルソートを用いたリレーションシップ自動構築エンジン
‘ ==============================================================================

‘ Windows API: メモリのクリーンアップ(大規模構築時のフラグメンテーション対策)
If VBA7 Then
Private Declare PtrSafe Sub CoFreeUnusedLibraries Lib “ole32.dll” ()
Private Declare PtrSafe Function SetProcessWorkingSetSize Lib “kernel32” ( _
ByVal hProcess As LongPtr, _
ByVal dwMinimumWorkingSetSize As LongPtr, _
ByVal dwMaximumWorkingSetSize As LongPtr) As Long
Else
Private Declare Sub CoFreeUnusedLibraries Lib “ole32.dll” ()
Private Declare Function SetProcessWorkingSetSize Lib “kernel32” ( _
ByVal hProcess As Long, _
ByVal dwMinimumWorkingSetSize As Long, _
ByVal dwMaximumWorkingSetSize As Long) As Long
End If

‘ 探索状態を表す列挙型
Private Enum NodeState
State_Unvisited = 0 ‘ 未訪問
State_Visiting = 1 ‘ 探索中(このパス上で遭遇 = 循環参照検知)
State_Visited = 2 ‘ 探索完了
End Enum

‘ リレーション定義のメタデータを保持する構造体
Public Type RelationDef
RelationName As String
PrimaryTable As String
ForeignTable As String
PrimaryField As String
ForeignField As String
Attributes As Long
End Type

‘ 内部管理用コレクション
Private m_Relations() As RelationDef
Private m_RelationCount As Long
Private m_UniqueTables As Object ‘ Scripting.Dictionary (テーブルリスト)
Private m_AdjList As Object ‘ Scripting.Dictionary (隣接リスト: 有向グラフ)
Private m_SortedTables As Object ‘ VBA.Collection (ソート結果)
Private m_States As Object ‘ Scripting.Dictionary (ノード訪問状態)

Private Sub Class_Initialize()
m_RelationCount = 0
ReDim m_Relations(0)
Set m_UniqueTables = CreateObject(“Scripting.Dictionary”)
m_UniqueTables.CompareMode = 1 ‘ バイナリではなくテキスト比較(大文字小文字無視)
Set m_AdjList = CreateObject(“Scripting.Dictionary”)
m_AdjList.CompareMode = 1
Set m_SortedTables = New VBA.Collection
Set m_States = CreateObject(“Scripting.Dictionary”)
m_States.CompareMode = 1
End Sub

Private Sub Class_Terminate()
Set m_UniqueTables = Nothing
Set m_AdjList = Nothing
Set m_SortedTables = Nothing
Set m_States = Nothing
‘ メモリの強制解放
Call OptimizeMemory
End Sub

‘ ——————————————————————————
‘ メソッド: AddRelationDefinition
‘ 概要: 構築したいリレーションシップのメタデータを登録する
‘ ——————————————————————————
Public Sub AddRelationDefinition( _
ByVal RelName As String, _
ByVal PriTable As String, _
ByVal ForTable As String, _
ByVal PriField As String, _
ByVal ForField As String, _
Optional ByVal Attribs As Long = dbRelationDeleteCascade Or dbRelationUpdateCascade)

ReDim Preserve m_Relations(m_RelationCount)
With m_Relations(m_RelationCount)
.RelationName = RelName
.PrimaryTable = PriTable
.ForeignTable = ForTable
.PrimaryField = PriField
.ForeignField = ForField
.Attributes = Attribs
End With

‘ テーブルのユニークリストを更新
m_UniqueTables(.PrimaryTable) = True
m_UniqueTables(.ForeignTable) = True

m_RelationCount = m_RelationCount + 1
End Sub

‘ ——————————————————————————
‘ メソッド: BuildRelations
‘ 概要: 解析を実行し、依存関係順にリレーションシップを物理構築する
‘ ——————————————————————————
Public Function BuildRelations(ByRef db As DAO.Database) As Boolean
On Error GoTo Error_Handler

If m_RelationCount = 0 Then
Debug.Print “警告: 登録されたリレーションシップ定義がありません。”
BuildRelations = True
Exit Function
End If

Debug.Print “=== 1. 依存関係グラフの構築開始 ===”
Call BuildGraph

Debug.Print “=== 2. 循環参照チェック & トポロジカルソート実行 ===”
If Not TopologicalSort() Then
Err.Raise vbObjectError + 513, “RelationSequencer”, “循環参照(閉路)が検出されたため、処理を中断しました。”
End If

Debug.Print “=== 3. 物理リレーションシップの構築開始 ===”

‘ トランザクション処理により、一括ロールバックを保証
DBEngine.BeginTrans

Dim i As Long
Dim tblName As Variant
Dim relDef As RelationDef

‘ トポロジカルソートされたテーブル順に従って、リレーションを生成していく
‘ (親テーブルが先に処理されることが保証されている)
For Each tblName In m_SortedTables
‘ 当該テーブルを「親(Primary)」とするリレーションを抽出し、追加
For i = 0 To m_RelationCount – 1
relDef = m_Relations(i)
If StrComp(relDef.PrimaryTable, tblName, vbTextCompare) = 0 Then
If Not CreateDAORelation(db, relDef) Then
Err.Raise vbObjectError + 514, “RelationSequencer”, “リレーションの作成に失敗しました: ” & relDef.RelationName
End If
End If
Next i
Next tblName

DBEngine.CommitTrans dbForceOSFlush
Debug.Print “=== リレーションシップの構築が正常に完了しました ===”
BuildRelations = True

Exit_Handler:
Call OptimizeMemory
Exit Function

Error_Handler:
On Error Resume Next
DBEngine.Rollback
Debug.Print “【致命的エラー】: ” & Err.Description
BuildRelations = False
Resume Exit_Handler
End Function

‘ ——————————————————————————
‘ 内部関数: BuildGraph (隣接リストの作成)
‘ ——————————————————————————
Private Sub BuildGraph()
Dim key As Variant
For Each key In m_UniqueTables.Keys
m_AdjList(key) = CreateObject(“Scripting.Dictionary”)
m_AdjList(key).CompareMode = 1
m_States(key) = State_Unvisited
Next key

‘ エッジ(依存関係)の追加: 親 -> 子
Dim i As Long
Dim pTable As String
Dim fTable As String
For i = 0 To m_RelationCount – 1
pTable = m_Relations(i).PrimaryTable
fTable = m_Relations(i).ForeignTable
‘ 重複エッジの防止
m_AdjList(pTable)(fTable) = True
Next i
End Sub

‘ ——————————————————————————
‘ 内部関数: TopologicalSort (トポロジカルソートの制御部)
‘ ——————————————————————————
Private Function TopologicalSort() As Boolean
Dim key As Variant

‘ すべてのノードに対してDFSを実行
For Each key In m_UniqueTables.Keys
If m_States(key) = State_Unvisited Then
If Not DFS(key) Then
‘ 循環参照検知
TopologicalSort = False
Exit Function
End If
End If
Next key

TopologicalSort = True
End Function

‘ ——————————————————————————
‘ 内部関数: DFS (深さ優先探索によるトポロジカルソート & 閉路検出)
‘ ——————————————————————————
Private Function DFS(ByVal node As String) As Boolean
‘ 探索中(一時マーク)に設定
m_States(node) = State_Visiting

Dim neighbors As Object
Set neighbors = m_AdjList(node)

Dim neighbor As Variant
For Each neighbor In neighbors.Keys
Dim state As Long
state = m_States(neighbor)

If state = State_Visiting Then
‘ 探索中のノードに再遭遇 = 循環参照(閉路)の存在を意味する
Debug.Print “【循環参照検知】: ” & node & ” <--> ” & neighbor
DFS = False
Exit Function
ElseIf state = State_Unvisited Then
If Not DFS(CStr(neighbor)) Then
DFS = False
Exit Function
End If
End If
Next neighbor

‘ 探索完了(確定マーク)に設定
m_States(node) = State_Visited

‘ ソート結果の先頭に追加(逆順に格納することでトポロジカル順序にする)
If m_SortedTables.Count = 0 Then
m_SortedTables.Add node
Else
m_SortedTables.Add node, Before:=1
End If

DFS = True
End Function

‘ ——————————————————————————
‘ 内部関数: CreateDAORelation (物理リレーション生成)
‘ ——————————————————————————
Private Function CreateDAORelation(ByRef db As DAO.Database, ByRef def As RelationDef) As Boolean
On Error GoTo Error_Handler

Dim rel As DAO.Relation
Dim fld As DAO.Field

‘ 同名のリレーションが既に存在する場合は一旦削除(冪等性の担保)
On Error Resume Next
db.Relations.Delete def.RelationName
On Error GoTo Error_Handler

‘ Relationオブジェクトの作成
Set rel = db.CreateRelation(def.RelationName, def.PrimaryTable, def.ForeignTable, def.Attributes)

‘ 関連付けるフィールドの定義
Set fld = rel.CreateField(def.PrimaryField)
fld.ForeignName = def.ForeignField

‘ フィールドをRelationオブジェクトに追加
rel.Fields.Append fld

‘ Databaseオブジェクトにリレーションを追加
db.Relations.Append rel

Debug.Print “リレーション構築成功: ” & def.RelationName & ” (” & def.PrimaryTable & ” -> ” & def.ForeignTable & “)”
CreateDAORelation = True

Exit_Handler:
‘ DAOオブジェクトの明示的解放(メモリリーク防止の定石)
Set fld = Nothing
Set rel = Nothing
Exit Function

Error_Handler:
Debug.Print “【リレーション構築失敗】: ” & def.RelationName & ” – エラー: ” & Err.Description
CreateDAORelation = False
Resume Exit_Handler
End Function

‘ ——————————————————————————
‘ 内部関数: OptimizeMemory (メモリの最適化)
‘ ——————————————————————————
Private Sub OptimizeMemory()
On Error Resume Next
‘ COMオブジェクトの未使用ライブラリを解放
Call CoFreeUnusedLibraries
‘ ワーキングセットの最小化
#If VBA7 Then
Call SetProcessWorkingSetSize(-1, -1, -1)
#Else
Call SetProcessWorkingSetSize(-1, -1, -1)
#End If
End Sub

3. 実装コードのディープダイブ:なぜこの設計なのか

このエンジンには、一般的なAccess VBAの解説書には書かれていない、過酷なエンタープライズ環境を生き抜くためのアーキテクチャが施されている。

① `Scripting.Dictionary` を用いた「隣接リスト(Adjacency List)」の表現

グラフ理論をプログラムで表現する際、隣接行列(Adjacency Matrix)はメモリ消費量が $O(V^2)$ となり非効率である($V$ はテーブル数)。
本ロジックでは、`Scripting.Dictionary` の中にさらに `Scripting.Dictionary` を内包させることで、$O(V + E)$($E$ はリレーション数)のメモリ効率を持つ「隣接リスト」を構築している。これにより、200テーブルを超える巨大なスキーマであってもミリ秒単位で解析が完了する。

② DFS(深さ優先探索)による「3色着色アルゴリズム」

循環参照の検出には、グラフ理論の「3色着色(Tri-color marking)」アルゴリズムを応用している。

  • `State_Unvisited`(白): まだ探索していないテーブル
  • `State_Visiting`(灰色): 現在探索中(コールスタックに積まれている)のテーブル
  • `State_Visited`(黒): その先にあるすべての依存関係をチェックし終えたテーブル

DFSの再帰処理中に、「現在探索中(灰色)」のノードに再度遭遇した場合、それは数学的に「閉路(ループ)」が存在することを示す。 これを検知した瞬間に処理を安全にロールバックし、不整合なリレーション構築を未然に防ぐ。

③ Windows API を用いたワーキングセットの強制クリーンアップ

Access(特に32bit版)は、DAOオブジェクトを大量に生成・破棄すると、内部メモリ(ヒープ領域)の断片化(フラグメンテーション)を起こしやすい。
本エンジンは、デストラクター(`Class_Terminate`)および処理の節目において `CoFreeUnusedLibraries` と `SetProcessWorkingSetSize` を呼び出し、OSに対して物理メモリへのスワップバックと解放を指示する。これにより、何百回連続して実行してもAccessが「リソース不足」で異常終了することはない。

4. クライアントコード:実戦での運用例

このクラスを実際に動作させるクライアントコードを示す。
ここでは、わざと複雑に絡み合ったテーブル群を想定し、さらに循環参照のテストも行えるように設計してある。

標準モジュールでの実行例

Public Sub Execute_Relationship_Migration()
Dim db As DAO.Database
Set db = CurrentDb

‘ エンジンのインスタンス化
Dim sequencer As RelationSequencer
Set sequencer = New RelationSequencer

‘ ————————————————————————–
‘ テストスキーマ定義(複雑な依存関係)
‘ ————————————————————————–
‘ 1. 顧客 (tblCustomers) -> 注文 (tblOrders)
‘ 2. 社員 (tblEmployees) -> 注文 (tblOrders)
‘ 3. 注文 (tblOrders) -> 注文明細 (tblOrderDetails)
‘ 4. 商品 (tblProducts) -> 注文明細 (tblOrderDetails)

‘ ※ 構築順序は、親となる「Customers」「Employees」「Products」が先になり、
‘ 次に「Orders」、最後に「OrderDetails」が構築されなければならない。

With sequencer
‘ 顧客 -> 注文
.AddRelationDefinition “FK_Customers_Orders”, _
“tblCustomers”, “tblOrders”, _
“CustomerID”, “CustomerID”

‘ 社員 -> 注文
.AddRelationDefinition “FK_Employees_Orders”, _
“tblEmployees”, “tblOrders”, _
“EmployeeID”, “EmployeeID”

‘ 注文 -> 注文明細
.AddRelationDefinition “FK_Orders_OrderDetails”, _
“tblOrders”, “tblOrderDetails”, _
“OrderID”, “OrderID”

‘ 商品 -> 注文明細
.AddRelationDefinition “FK_Products_OrderDetails”, _
“tblProducts”, “tblOrderDetails”, _
“ProductID”, “ProductID”

‘ 【実験用】もし循環参照をテストしたい場合は、以下のコメントを外す
‘ .AddRelationDefinition “FK_Circular_Loop”, _
‘ “tblOrderDetails”, “tblCustomers”, _
‘ “DetailID”, “CustomerID”
End With

‘ 実行
Debug.Print “— リレーション構築処理 開始 —”
Dim success As Boolean
success = sequencer.BuildRelations(db)

If success Then
MsgBox “リレーションシップの再構築が成功しました。”, vbInformation, “処理完了”
Else
MsgBox “エラーが発生したため、処理はロールバックされました。”, vbCritical, “処理失敗”
End If

‘ 後処理
Set sequencer = Nothing
Set db = Nothing
End Sub

5. レガシー保守とシステム連携における現場の知見

実務において、この自動構築エンジンを導入する際には、以下の点に留意していただきたい。

インデックスの事前生成を怠るな

DAOで `Relation` を追加する際、親テーブルの参照フィールドには 主キー(Primary Key) または 一意(Unique)インデックス が事前に定義されていなければならない。
このエンジンを走らせる前に、DDL(`CREATE UNIQUE INDEX…`)またはDAOの `TableDef.Indexes` コレクションを用いて、親フィールドのインデックスを確実に作成しておくこと。インデックスが存在しない場合、エンジンは構築フェーズで例外を検知し、トランザクション全体を安全にロールバックする。

`dbRelationDontEnforce` の使い所

もし、移行元の古いデータに「既に参照整合性を満たしていないゴミデータ」が含まれており、かつデータのクリーニングを後回しにしてでも一旦リレーションシップの「形」だけを作りたい場合、`AddRelationDefinition` の引数 `Attribs` に `dbRelationDontEnforce` を指定する。
これにより、参照整合性チェック(RI)を一時的に無効化したリレーションシップを張り、データ移行後にクエリで不整合データを抽出・修正してから、再度制約を有効(`dbRelationDeleteCascade` 等)に再構築する、といった柔軟な二段階移行シナリオが可能になる。

‘ 参照整合性を強制しない(移行期の一時的な設定)
.AddRelationDefinition “FK_Customers_Orders”, “tblCustomers”, “tblOrders”, _
“CustomerID”, “CustomerID”, dbRelationDontEnforce

結言

RDBの整合性を維持しつつ、システム構造を動的に制御する技術は、Access VBAプログラミングにおける一つの到達点である。
今回提示したトポロジカル・シーケンサーは、データ構造の乱れから生じるエラーを未然に防ぎ、大規模システムにおけるDDLメンテナンスを完全に自動化するための強力な武器となる。

コードの背後にある「オブジェクトのライフサイクル管理」と「グラフ理論による数理的解決」の思想を理解し、貴方の開発現場のレガシーシステムを、よりモダンで堅牢なアーキテクチャへと昇華させてほしい。

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