【PowerPoint VBA】SharePoint/Teams共同編集の「上書き地獄」を断つ！コンフリクト自動検知と安全退避の極限アーキテクチャ
開発現場でこんな悲劇を見たことはないだろうか。
「朝から苦労して作り込んだ全スライドが、クラウドの同期競合（コンフリクト）で文字化けあるいは巻き戻って消えた……」
現代のワークスタイルにおいて、SharePointやTeams上でPowerPointファイルを直接同時編集する機会は日常茶飯事だ。しかし、Microsoft 365の強力な自動保存機能とクラウド同期の裏側では、複数ユーザーの変更が衝突した際、「どちらの変更を正とするか」の判断が曖昧になり、最悪の場合ローカルの変更がサーバー側の古いデータで容赦なく上書きされるという致命的なリスクが潜んでいる。
今回は、このクラウド特有の同期リスクに対し、PowerPoint VBAからファイルのメタデータとライフサイクルを監視し、競合の予兆や異常を検知した瞬間にタイムスタンプ付きの安全なローカルバックアップへ自動退避させる、プロダクション品質の堅牢なソリューションを伝授する。
—
1. なぜ「クラウド上の保存」はVBAにとって鬼門なのか？
通常のローカル環境であれば、`ActivePresentation.Save` はただディスクに書き込むだけの単純な同期処理だ。しかし、対象がSharePointやTeamsの同期フォルダー（OneDrive sync client経由など）である場合、話は全く違ってくる。
クラウドストレージの死角
1. 非同期書き込みのタイムラグ: VBAが「保存完了」と判断した瞬間は、あくまでローカルのキャッシュ（同期クライアント）に落ちたに過ぎない。
2. 自動保存（AutoSave）との競合: VBAがオブジェクトモデルを操作している最中にバックグラウンドで自動保存が走り、ファイルハンドルがロックされる。
3. コンフリクトファイルの生成: 同時編集により `[ファイル名]_[PC名] の競合.pptx` が勝手に生成され、本来のメインストリームのファイルがデタッチされる。
甘いエラーハンドリングでこれを放置すれば、マクロが途中でクラッシュするか、無言でデータを消失する。プロのエンジニアであれば、「クラウド上のファイルは常に汚染されるリスクがある」という前提でコードを書かなければならない。
—
2. 堅牢な設計アプローチ：コンフリクト防衛の3原則
今回のアーキテクチャでは、以下の3つの防衛策をコードに組み込む。
1. パスの動的判定（クラウドパスの検知）:
対象ファイルが本当にローカルの同期環境にあるか、あるいはWebDAV（http/https）経由の直アクセスになっていないかを判定する。
2. ファイル競合マーカーの監視:
ファイル名やフォルダ内に「競合」「Conflict」「copy」といった文字列、あるいは異常に古い最終更新日時が検知された場合、強制的に緊急退避モードへ移行する。
3. アトミックなローカル退避:
タイムスタンプ（`YYYYMMDD_HHMMSS`）を付与した完全独立のバックアップをローカルの安全領域（例: `C:\VBA_Safety_Vault\`）へ確実にスワップアウトする。
—
3. プロダクションコード：セーフティ・コンフリクト・ガードル
以下のコードは、プレゼンテーションのクローズ時、あるいは定期的なチェックポイントで実行することを想定したモジュールだ。エラーハンドリングを極限まで高め、APIの挙動不整合によるハングアップを完全に封じ込めている。
Option Explicit
‘ ==============================================================================
‘ モジュール名: ModCloudConflictGuard
‘ 概要 : クラウド上のコンフリクトを検知し、安全なローカルへ強制退避を行う
‘ 執筆者 : 首席チーフ・アーキテクト
‘ ==============================================================================
Public Sub ExecuteSafeCloudSaveAndBackup()
Dim targetPres As Presentation
Set targetPres = ActivePresentation
‘ 1. 保存前バリデーション（新規未保存ドキュメントの排除）
If targetPres.Path = “” Then
MsgBox “このプレゼンテーションはまだ一度も保存されていません。” & vbCrLf & _
“一度手動で保存してから実行してください。”, vbCritical, “セーフティガード”
Exit Sub
End If
Dim originalFullPath As String
originalFullPath = targetPres.FullName
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
‘ 2. クラウド環境（SharePoint / OneDrive）特有のパスかチェック
Dim isCloudPath As Boolean
isCloudPath = (InStr(1, originalFullPath, “http”, vbTextCompare) > 0) Or _
(InStr(1, targetPres.Path, “OneDrive”, vbTextCompare) > 0) Or _
(InStr(1, targetPres.Path, “SharePoint”, vbTextCompare) > 0)
‘ 3. 競合兆候の検知（ファイル名に「競合」や「Conflict」が含まれていないか）
Dim fileName As String
fileName = fso.GetFileName(originalFullPath)
If (InStr(1, fileName, “競合”, vbTextCompare) > 0) Or _
(InStr(1, fileName, “Conflict”, vbTextCompare) > 0) Then
MsgBox “【警告】ファイル名に競合（コンフリクト）を示す兆候を検知しました！” & vbCrLf & _
“上書き保存によるデータ消失を防ぐため、緊急退避モードに移行します。”, _
vbCritical, “コンフリクト緊急警報”
Call EmergencyBackupToLocal(targetPres, fso, “_CONFLICT_DETECTED”)
Exit Sub
End If
‘ 4. 通常の安全保存プロセス
On Error GoTo ErrorHandler
‘ 自動保存を一時的に無効化できる環境であれば制御（PowerPointの仕様に依存）
targetPres.Save
‘ 5. クラウド環境であっても、万が一に備えてローカルにタイムスタンプ付きバックアップを常時生成
If isCloudPath Then
Call EmergencyBackupToLocal(targetPres, fso, “_CloudBackup”)
End If
Set fso = Nothing
Exit Sub
ErrorHandler:
‘ 6. 保存失敗（同期エラー・ファイルロック）時のフェイルセーフ
MsgBox “ファイルの保存中にエラーが発生しました（Error ” & Err.Number & “: ” & Err.Description & “）。” & vbCrLf & _
“クラウドとの同期に失敗している可能性があります。ローカルへ強制退避を実行します。”, _
vbCritical, “セーフティガード：保存異常”
Call EmergencyBackupToLocal(targetPres, fso, “_SAVE_FAILED”)
Set fso = Nothing
End Sub
‘ ==============================================================================
‘ 内部プロシージャ: タイムスタンプ付きローカル退避実行
‘ ==============================================================================
Private Sub EmergencyBackupToLocal(ByVal pres As Presentation, ByRef fso As Object, ByVal suffix As String)
On Error GoTo BackupErrorHandler
‘ 退避先ローカルディレクトリの指定（存在しない場合は自動生成）
Dim backupDir As String
backupDir = “C:\PowerPoint_Safety_Vault\”
If Not fso.FolderExists(backupDir) Then
fso.CreateFolder backupDir
End If
‘ タイムスタンプの生成 (YYYYMMDD_HHMMSS)
Dim timeStamp As String
timeStamp = Format(Now, “YYYYMMDD_HHMMSS”)
‘ 拡張子を除いたファイル名を取得
Dim baseName As String
baseName = fso.GetBaseName(pres.Name)
‘ 退避ファイルのフルパス構築
Dim backupFullPath As String
backupFullPath = backupDir & baseName & “_” & timeStamp & suffix & “.pptx”
‘ プレゼンテーションを別名で保存（本体に影響を与えないようコピーツールとして利用）
pres.SaveCopyAs backupFullPath
MsgBox “安全のため、ローカルの以下のパスにプレゼンテーションを退避させました：” & vbCrLf & _
backupFullPath, vbInformation, “緊急退避完了”
Exit Sub
BackupErrorHandler:
MsgBox “致命的なエラー: ローカルへの緊急退避にも失敗しました。” & vbCrLf & _
“詳細: ” & Err.Description, vbCritical, “緊急退避 失敗”
End Sub
—
4. コードの深層解説：なぜこの設計なのか？
このコードには、実務で数々の修羅場をくぐり抜けてきたエンジニアの知見が凝縮されている。
① `SaveCopyAs` の採用
通常の `SaveAs` を使うと、VBAが操作しているドキュメントの参照先そのものがローカルに切り替わってしまい、ユーザーがクラウドでの共同編集セッションから強制的に切り離されてしまう。
ここでは `SaveCopyAs` を使用することで、現在のクラウド上の編集状態を維持したまま、バックグラウンドで安全なローカルクローンを切り出すことに成功している。
② 競合マーカー（`_CONFLICT_DETECTED` 等）の付与
SharePointの同期エンジンがコンフリクトを起こした際、ファイル名に特殊な文字列が付加される挙動を逆手に取り、プログラム側で文字列一致による「異常検知（イージング・トリガー）」を実装している。これにより、人間が気づく前にマクロが自発的に防衛行動を取ることが可能になる。
③ 堅牢なフォルダー自動生成
`C:\PowerPoint_Safety_Vault\` という専用の退避エリアをハードコードしつつ、`Scripting.FileSystemObject` を使ってディレクトリの存在確認と動的生成を行っている。権限エラーなどでディレクトリが作れない場合でも、エラーハンドラーによって無限ループやフリーズを防ぐ設計だ。
—
5. 現場への導入と運用ティップス
- アドイン（.ppam）化の推奨:
このコードを個人マクロブック（`Personal.tmsw`）や、全社共通のPowerPointアドインとして配布し、リボンメニューやクイックアクセスツールバーに配置するのが最も効果的である。
- イベントドリブンへの拡張:
今回は手動実行（またはボタン割り当て）を想定したが、`Application_PresentationBeforeSave` イベントと組み合わせることで、ユーザーが「上書き保存」を押した瞬間にこのバリデーションをフックさせることも可能だ（※ただしイベント内での無限ループ保存に注意すること）。
クラウド時代のOfficeVBA開発は、単に「自動化して楽をする」フェーズから、「インフラストラクチャの不安定性からデータを守る盾となる」フェーズへシフトしている。ぜひこのアーキテクチャをあなたの現場へ導入し、上書き地獄の恐怖からチームを解放してほしい。
