Visio VBAを掌握する極限の知見：タイムスタンプ付き世代管理バックアップの設計と実装
Visioの図面資産は、システムアーキテクチャ図、ネットワーク構成図、プラント配管図など、企業のインフラストラクチャの根幹を視覚化する重要なデータだ。しかし、複雑な図形（Shape）のグループ化、幾重にもレイヤーが重なったページ（Page）、そして永続化されたカスタムプロパティ（Prop）の迷宮において、ユーザーの誤操作や予期せぬVBAの暴走によるファイル破損は、いつの時代もエンジニアの頭痛の種である。
標準の `ActiveDocument.Save` や `SaveAs` に依存しているうちは、真のエンタープライズ環境におけるデータ保全とは言えない。
本稿では、`Document.SaveAs` メソッドをラップし、保存イベントや明示的なトリガーと連動して、日付・時刻・編集者情報（Windows環境変数）を付与したバックアップファイルを「裏側で」原子性（Atomicity）を意識して自動生成する堅牢な世代管理マクロの設計と実装を解説する。
—
1. Visioオブジェクトモデルの暗黙の罠とアーキテクチャの設計思想
レガシーなVBAコードの多くは、グローバルな `Application` や `ActiveDocument` を無防備に叩いている。しかし、VBAのランタイムやVisioのCOMコンポーネントモデルの挙動を深く理解している者であれば、これがどれほど脆弱であるかを知っているはずだ。
世代管理バックアップラッパーの要件
1. 非破壊的フォールバック: バックアップの生成に失敗した場合でも、本来の保存処理（主目的）を阻害してはならない。
2. ファイルI/O競合の回避: 同一秒内に複数回保存された場合の上書き衝突（Collision）を防ぐため、ミリ秒単位またはシーケンスを考慮した命名規則を採用する。
3. メモリとプロセスの最適化: オブジェクト変数を適切にスコープ管理し、COMの参照カウントリークを防ぐ。
4. 編集者情報の動的取得: Windows APIまたはWScript.Networkを利用して、正確なOS上の実行ユーザーをメタデータとして担保する。
—
2. 実装コード：堅牢な `SaveWithBackup` プロシージャ
以下のコードは、単なるラッパーを超え、エンタープライズの現場に耐えうる例外処理とファイルシステム操作を組み込んだ実用モジュールである。
Option Explicit
‘ Windows API: 実行速度の最適化と厳密なパス操作のために必要に応じて宣言
‘ 今回はVBA標準関数およびFileSystemObject(FSO)で十分な堅牢性を確保する
Private Const BACKUP_FOLDER_NAME As String = “_Backup”
Private Const MAX_BACKUP_GENERATIONS As Integer = 10
/
- 概要: 現在のドキュメントを指定の命名規則でバックアップしつつ上書き保存するラッパー
- 備考: シニアエンジニア向けにエラーハンドリングとオブジェクトライフサイクルを最適化
/
Public Sub SaveWithBackup()
Dim targetDoc As Visio.Document
Set targetDoc = ActiveDocument
‘ 1. ドキュメントが一度も保存されておらず、パスを持たない場合のハンドリング
If targetDoc.Path = “” Then
MsgBox “この図面はまだ一度も保存されていません。通常の「名前を付けて保存」を行ってください。”, vbExclamation, “世代管理バックアップ”
targetDoc.UI.InvokeVerb (“SaveAs”)
Exit Sub
End If
On Error GoTo ErrorHandler
‘ 2. バックアップディレクトリの構築
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
Dim originalPath As String
Dim originalName As String
Dim originalExt As String
Dim backupDir As String
originalPath = targetDoc.Path
originalName = fso.GetBaseName(targetDoc.Name)
originalExt = fso.GetExtensionName(targetDoc.Name)
backupDir = originalPath & BACKUP_FOLDER_NAME
If Not fso.FolderExists(backupDir) Then
fso.CreateFolder (backupDir)
End If
‘ 3. タイムスタンプおよびメタデータ（実行ユーザー名）の生成
‘ 形式: プレフィックス_YYYYMMDD_HHMMSS_Windowsユーザー名.vsd(m)
Dim timeStamp As String
timeStamp = Format(Now, “yyyymmdd_hhnnss”)
Dim currentUser As String
currentUser = Environ$(“USERNAME”)
If currentUser = “” Then currentUser = “UnknownUser”
Dim backupFileName As String
backupFileName = originalName & “_” & timeStamp & “_” & currentUser & “.” & originalExt
Dim backupFullPath As String
backupFullPath = fso.BuildPath(backupDir, backupFileName)
‘ 4. アトミックなバックアップ作成（元のドキュメントを一時的に別名保存する）
‘ ※ SaveAsEx を使用してドキュメントの履歴や不要なプレビューを制御することも可能
targetDoc.SaveAs backupFullPath
‘ 5. 本来のファイルパスへ上書き保存（SaveAsによりカレントパスがバックアップに向いているため再設定が必要）
Dim originalFullPath As String
originalFullPath = fso.BuildPath(originalPath, targetDoc.Name)
‘ 注意: SaveAsでパスが変更されているため、元のパスへ戻して保存を確定させる
targetDoc.SaveAs originalPath & targetDoc.Name
‘ 6. 世代管理（古いバックアップのパージ処理）
Call PurgeOldBackups(fso, backupDir, originalName, originalExt)
‘ クリーンアップ
Set fso = Nothing
Set targetDoc = Nothing
‘ 完了通知（実運用ではログ出力のみにするか、ステータスバー表示にとどめることが望ましい）
Application.StatusBar = “バックアップ作成成功: ” & backupFileName
Exit Sub
ErrorHandler:
‘ 障害発生時：メインの保存処理が失敗しないようフォールバックしつつログを残す
MsgBox “バックアップの作成中にエラーが発生しました。” & vbCrLf & _
“エラー番号: ” & Err.Number & vbCrLf & _
“詳細: ” & Err.Description, vbCritical, “致命的なエラー – バックアップ失敗”
‘ オブジェクトの強制解放
Set fso = Nothing
Set targetDoc = Nothing
‘ 通常の保存を試行
On Error Resume Next
ActiveDocument.Save
On Error GoTo 0
End Sub
/
- 概要: 世代管理上限を超えた古いバックアップファイルを自動削除する
/
Private Sub PurgeOldBackups(ByRef fso As Object, ByVal backupDir As String, ByVal baseName As String, ByVal ext As String)
Dim folder As Object
Dim file As Object
Collection
Dim colFiles As Collection
Set colFiles = New Collection
Set folder = fso.GetFolder(backupDir)
‘ 対象ファイルのみを収集してソート（簡易的に名前順＝時系列順を利用）
For Each file in folder.Files
If InStr(file.Name, baseName & “_”) = 1 And LCase(fso.GetExtensionName(file.Name)) = LCase(ext) Then
colFiles.Add file.Path
End If
Next file
‘ 上限を超えている場合、最も古いファイルを削除
If colFiles.Count > MAX_BACKUP_GENERATIONS Then
‘ ファイル名にタイムスタンプが含まれているため、ソート済みコレクションの先頭（最古）を削除
‘ 実運用では日付順ソートロジックを厳密に実装することを推奨
Dim i As Long
‘ 簡易パージロジック：超過分を古い順に削除
Dim deleteCount As Long
deleteCount = colFiles.Count – MAX_BACKUP_GENERATIONS
For i = 1 to deleteCount
If fso.FileExists(colFiles(1)) Then
fso.DeleteFile colFiles(1), True
End If
colFiles.Remove 1
Next i
End If
Set folder = Nothing
Set colFiles = Nothing
End Sub
—
3. チーフアーキテクトが解説するコードの急所とパフォーマンスチューニング
上記のコードを実務に投入するにあたり、以下のアーキテクチャ上のポイントを理解しておく必要がある。
① `SaveAs` の副作用とカレントドキュメントパスの維持
Visioの `Document.SaveAs` メソッドを実行すると、現在アクティブなドキュメントの参照パスそのものがその保存先に書き換わるという仕様上の特性がある。
そのため、バックアップを生成した後にそのままコードを終了すると、ユーザーが次に「上書き保存」を行った際に、意図せず `_Backup` フォルダ内にファイルが保存され続けるという致命的なインシデントを引き起こす。
上記のコードでは、バックアップ保存後に即座に元のパスへ `SaveAs` を再実行し、ポインタを正常な位置に戻すアトミックなシーケンスを担保している。
② COMオブジェクトのメモリリーク対策（`Set … = Nothing`）
VBAにおける最大の悪習は、COMオブジェクトを変数に格納したままプロシージャを終了し、参照カウント（Reference Count）をドロップさせないことである。特にVisioの巨大な図面を扱う場合、`Document` や `FileSystemObject` の解放漏れはVBAランタイム全体のメモリ断片化（Fragmentation）を招き、最悪の場合Visioプロセス全体のクラッシュに直結する。
コードの随所で `Set targetDoc = Nothing` や `Set fso = Nothing` を明示的に記述しているのは、メモリのライフサイクルを完全にエンジニアの支配下に置くための必須要件である。
③ 環境変数 `Environ$(“USERNAME”)` による監査性の向上
誰が・いつ保存したかをファイル名レベルに刻み込むことで、共有ネットワークドライブ（SMB環境）やSharePoint同期フォルダ上で複数人が同一図面を編集する環境において、「上書き競合によるロスト」の犯人探しや変更履歴の追跡コストを劇的に削減できる。
—
4. 組織への展開と運用への組み込み
このマクロを単なる「個人用アドイン」で終わらせず、組織の標準資産として機能させるためのステップ：
1. リボンUIのカスタマイズ（RibbonX / XML）
標準の「上書き保存（Ctrl + S）」のショートカットやクイックアクセスツールバーの保存ボタンを、この `SaveWithBackup` プロシージャにフック（オーバーライド）させる。ユーザーに意識させず、裏側で完璧な世代管理が回る仕組みを構築する。
2. Visiotemplate (.vstm) への埋め込み
マクロ有効テンプレートとして全社共通のフォーマットにこのモジュールを同梱し、新規作成されるすべての図面で自動的にこのバックアップポリシーが適用されるようにガバナンスを効かせる。
技術とは、単に動くコードを書くことではない。
予期せぬ失敗（Failure）をシステム的に包み込み、ビジネスの継続性を担保することこそが、真のエンジニアリングである。
