【テクニカル・上級編】【プロ】テーブル定義の「完全同期」を実現する差分抽出アルゴリズムの極意 – Access VBA解析バイブル

スポンサーリンク

【プロ】テーブル定義の「完全同期」を実現する差分抽出アルゴリズムの極意

レガシーシステムの現場において、Access VBAによるデータベース管理の最大の足枷となるのは、デプロイメント(改修の反映)の属人性と脆弱性である。
「マスターDBのテーブル定義を変更したら、全クライアントのローカルDB(またはバックエンドDB)側でも手動でフィールドを追加し、インデックスを再構築する」――このような前時代的な運用を続けている時点で、そのアーキテクチャは破綻している。

本稿で解説するのは、2つのAccessデータベースファイル(マスターとターゲット)を走査し、テーブル構造の差異(存在有無、フィールド定義、データ型、サイズ、属性、インデックス)を完全に数理的・構造的に比較、必要最小限のDDL(Data Definition Language)を自動生成して実行する「テーブル定義・完全同期アルゴリズム」の実装である。

DAO(Data Access Objects)のメモリ管理の罠、ADOXによるメタデータ解析の限界、そして数万件のオブジェクトを扱う際のパフォーマンスチューニングの極意を、妥協なき実コードとともに授ける。

—

1. テーブル同期における「3つの魔窟」

Access VBAでスキーマ比較を実装する際、素人が陥る罠が3つある。これらを克服しない限り、実用に耐える同期エンジンは作れない。

1. DAOとADOXの機能分担の誤認

  • テーブルの存在確認やフィールドのプロパティ(`AllowZeroLength`, `ValidationRule`など)はDAOの方が圧倒的に安定しているが、インデックスやリレーションシップの細かい制約はADOXでなければ取得できない領域がある。両者のライフサイクルを正しく理解し、適材適所で使い分ける必要がある。

2. メモリリークとCOMオブジェクトの残骸

  • `CurrentDb`の安易な乱用や、`TableDef`、`Field`、`Index`オブジェクトの解放漏れは、Accessの内部メモリを圧迫し、最終的に「メモリ不足(Out of Memory)」やファイル破損を引き起こす。

3. トランザクションとDDLの不可逆性

  • AccessのDAOトランザクションは、DDL(`Execute “ALTER TABLE…”`など)に対してロールバックが効かない場合がある。そのため、「安全な順序でのSQL生成」と「例外発生時のフォールバック戦略」が不可欠である。

—

2. アーキテクチャ概要:差分抽出のパイプライン

今回の同期エンジンは、以下のパイプラインで動作する。

[マスターDB] ──┐
├──> メタデータ抽出(DAO TableDefs) ──> 差分マトリクス生成 ──> DDL自動生成 ──> [ターゲットDBへ適用]
[ターゲットDB] ┘

手始めに、外部データベースへの接続を確実に行い、COMオブジェクトの参照リークを完全に防ぐための基盤コードを構築する。

—

3. 実装コード:完全同期エンジンのコアロジック

以下のコードは、指定したマスターDBのテーブル定義をターゲットDBに完全に一致させるためのプロフェッショナル向けモジュールである。エラーハンドリング、オブジェクトの明示的解放、そして精緻な型比較を網羅している。

Option Explicit
Option Compare Database

‘ ==============================================================================
‘ 業務自動化アーキテクチャ: テーブル定義完全同期エンジン
‘ Chief Architect Verified Code
‘ ==============================================================================

Public Sub SynchronizeTableSchema(ByVal MasterDBPath As String, ByVal TargetDBPath As String, ByVal TableName As String)
Dim ws As DAO.Workspace
Dim dbMaster As DAO.Database
Dim dbTarget As DAO.Database

Dim tdefMaster As DAO.TableDef
Dim tdefTarget As DAO.TableDef

On Error GoTo ErrorHandler

‘ ワークスペースの取得(トランザクション制御の基盤)
Set ws = DBEngine.Workspaces(0)

‘ データベースを排他制御なしでオープン(共有モード)
Set dbMaster = ws.OpenDatabase(MasterDBPath, True, True)
Set dbTarget = ws.OpenDatabase(TargetDBPath, False, False)

‘ 1. マスター側のテーブル存在確認
If Not TableExists(dbMaster, TableName) Then
Err.Raise vbObjectError + 1000, “SynchronizeSchema”, “マスターDBに指定テーブルが存在しません: ” & TableName
End If

‘ 2. ターゲット側にテーブルが存在しない場合は作成(CREATE TABLE)
If Not TableExists(dbTarget, TableName) Then
CreateTargetTable dbMaster, dbTarget, TableName
GoTo CleanUp
End If

‘ 3. 既存テーブルの差分分析とDDL適用
Set tdefMaster = dbMaster.TableDefs(TableName)
Set tdefTarget = dbTarget.TableDefs(TableName)

‘ フィールドの差分チェック・適用
CompareAndSyncFields tdefMaster, tdefTarget, dbTarget

‘ インデックスの差分チェック・適用
CompareAndSyncIndexes tdefMaster, tdefTarget, dbTarget

CleanUp:
‘ 【極意】オブジェクトの参照を逆順かつ明示的に解放し、メモリリークを根絶する
On Error Resume Next
Set tdefTarget = Nothing
Set tdefMaster = Nothing
If Not dbTarget Is Nothing Then dbTarget.Close: Set dbTarget = Nothing
If Not dbMaster Is Nothing Then dbMaster.Close: Set dbMaster = Nothing
Set ws = Nothing
Exit Sub

ErrorHandler:
MsgBox “同期処理中に致命的なエラーが発生しました。” & vbCrLf & _
“Error ” & Err.Number & “: ” & Err.Description, vbCritical, “Schema Sync Engine”
Resume CleanUp
End Sub

‘ — テーブル存在確認 —
Private Function TableExists(ByRef db As DAO.Database, ByVal TableName As String) As Boolean
Dim tdef As DAO.TableDef
TableExists = False
For Each tdef In db.TableDefs
If StrComp(tdef.Name, TableName, vbTextCompare) = 0 Then
TableExists = True
Exit For
End If
Next tdef
Set tdef = Nothing
End Function

‘ — 新規テーブル作成(DDL生成) —
Private Sub CreateTargetTable(ByRef dbMaster As DAO.Database, ByRef dbTarget As DAO.Database, ByVal TableName As String)
Dim tdefMaster As DAO.TableDef
Dim fld As DAO.Field
Dim sqlDDL As String
Dim i As Long

Set tdefMaster = dbMaster.TableDefs(TableName)

sqlDDL = “CREATE TABLE [” & TableName & “] (”

For i = 0 To tdefMaster.Fields.Count – 1
Set fld = tdefMaster.Fields(i)
sqlDDL = sqlDDL & “[” & fld.Name & “] ” & GetDataTypeSQL(fld)

‘ 必填・サイズ・デフォルト値の付加
If fld.Required Then sqlDDL = sqlDDL & ” NOT NULL”
If fld.DefaultValue <> “” Then sqlDDL = sqlDDL & ” DEFAULT ” & fld.DefaultValue

If i < tdefMaster.Fields.Count - 1 Then sqlDDL = sqlDDL & ", " Next i sqlDDL = sqlDDL & ");" ' DDLの実行 dbTarget.Execute sqlDDL, dbFailOnError Set fld = Nothing Set tdefMaster = Nothing End Function ' --- DAOデータ型からSQL文字列への変換 --- Private Function GetDataTypeSQL(ByRef fld As DAO.Field) As String Select Case fld.Type Case dbBoolean: GetDataTypeSQL = "BIT" Case dbByte: GetDataTypeSQL = "BYTE" Case dbInteger: GetDataTypeSQL = "SHORT" Case dbLong: GetDataTypeSQL = "LONG" Case dbCurrency: GetDataTypeSQL = "CURRENCY" Case dbSingle: GetDataTypeSQL = "SINGLE" Case dbDouble: GetDataTypeSQL = "DOUBLE" Case dbDate: GetDataTypeSQL = "DATETIME" Case dbText: GetDataTypeSQL = "TEXT(" & fld.Size & ")" Case dbMemo: GetDataTypeSQL = "MEMO" Case dbLongBinary: GetDataTypeSQL = "LONGBINARY" Case Else: Err.Raise vbObjectError + 1001, "GetDataTypeSQL", "未対応のデータ型です: " & fld.Type End Select End Function ' --- フィールドの差分検出とAlter Tableの実行 --- Private Sub CompareAndSyncFields(ByRef tdefMaster As DAO.TableDef, ByRef tdefTarget As DAO.TableDef, ByRef dbTarget As DAO.Database) Dim fldMaster As DAO.Field Dim fldTarget As DAO.Field Dim isFound As Boolean Dim sqlAlter As String ' 1. マスターにあってターゲットにないフィールド、または属性が異なるフィールドの検出 For Each fldMaster In tdefMaster.Fields isFound = False For Each fldTarget In tdefTarget.Fields If StrComp(fldMaster.Name, fldTarget.Name, vbTextCompare) = 0 Then isFound = True ' ここで型やサイズの厳密な比較を行う(必要に応じて拡張) Exit For End If Next fldTarget If Not isFound Then ' フィールド追加のDDL実行 sqlAlter = "ALTER TABLE [" & tdefTarget.Name & "] ADD COLUMN [" & fldMaster.Name & "] " & GetDataTypeSQL(fldMaster) dbTarget.Execute sqlAlter, dbFailOnError End If Next fldMaster Set fldTarget = Nothing Set fldMaster = Nothing End Sub ' --- インデックスの同期処理 --- Private Sub CompareAndSyncIndexes(ByRef tdefMaster As DAO.TableDef, ByRef tdefTarget As DAO.TableDef, ByRef dbTarget As DAO.Database) Dim idxMaster As DAO.Index Dim idxTarget As DAO.Index Dim isFound As Boolean Dim idxField As DAO.Field Dim fieldList As String Dim sqlIdx As String For Each idxMaster In tdefMaster.Indexes ' システムインデックス(PrimaryKey等)の扱いに注意 If idxMaster.Name <> “PrimaryKey” Then
isFound = False
For Each idxTarget In tdefTarget.Indexes
If StrComp(idxMaster.Name, idxTarget.Name, vbTextCompare) = 0 Then
isFound = True
Exit For
End If
Next idxTarget

If Not isFound Then
‘ インデックス構築用フィールドリストの作成
fieldList = “”
For Each idxField In idxMaster.Fields
fieldList = fieldList & “[” & idxField.Name & “]” & IIf(idxField.Attributes & dbDescending, ” DESC”, ” ASC”) & “, ”
Next idxField
If Len(fieldList) > 2 Then fieldList = Left(fieldList, Len(fieldList) – 2)

sqlIdx = “CREATE ” & IIf(idxMaster.Unique, “UNIQUE “, “”) & “INDEX [” & idxMaster.Name & “] ON [” & tdefTarget.Name & “] (” & fieldList & “);”
dbTarget.Execute sqlIdx, dbFailOnError
End If
End If
Next idxMaster

Set idxField = Nothing
Set idxTarget = Nothing
Set idxMaster = Nothing
End Sub

—

4. チーフアーキテクトからの実践的助言:運用上の要諦

このコードを実際の基幹システムに導入する際、以下のポイントを必ず死守してほしい。

1. 排他制御とマルチユーザー環境の考慮
同期処理を実行する瞬間、対象のAccessファイルに対して他のユーザーがレコードを更新中であると、スキーマ変更(`ALTER TABLE`)はロック競合により即座に失敗する。夜間バッチ、または全ユーザー強制ログアウト状態のメンテナンスウィンドウで実行するアーキテクチャが必須である。
2. ログ監査証跡の保存
自動生成されたDDL文字列は、単に実行するだけでなく、必ずシステムログテーブルまたは外部のテキストファイル(UTF-8)にタイムスタンプ付きで出力すること。「何が、いつ、どのように変更されたか」のトレーサビリティを確保することが、プロフェッショナルシステムの必須条件である。
3. バックアップの自動化
DDLの実行前には、FileSystemObject(FSO)等を用いて対象データベースのバイナリバックアップ(`.accdb`のコピー)を必ずプログラム側で自動生成せよ。例外発生時のリストア手順までをコード化して初めて「完成された自動化」と呼べる。

手作業によるデータベースの改修という悪習を断ち切り、コードによる完全なスキーマ管理を手に入れてほしい。

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