【実務・中級編】【上級者】Windows API（GetDiskFreeSpaceEx）を用いて、保存先がネットワークドライブ（NAS）の場合に書き込み速度と空き容量を事前検証し、最適なバッファサイズで安全に保存する堅牢マクロ – PowerPoint VBA解析バイブル

「保存してエラー」を根絶せよ。Windows APIで実現するNAS保存の堅牢設計

多くのVBAエンジニアが陥る罠がある。それは、`Presentation.SaveAs` や `ExportAsFixedFormat` といったメソッドを呼び出し、「保存処理をOfficeに丸投げする」ことだ。

ローカル環境で動けば満足か？ 甘すぎる。
実務の現場では、保存先はNAS（ネットワーク共有フォルダ）であることがほとんどだ。ネットワークの瞬断、クォータ制限によるディスクフル、あるいは書き込み権限の不整合。これらが起きたとき、Officeの標準メソッドは「正体不明のエラー」を吐いて停止するか、最悪の場合、保存途中のファイルが破損し、元のデータまで巻き添えにする。

プロのエンジニアは、メソッドを叩く前に「環境を支配」する。
今回は、Windows API `GetDiskFreeSpaceEx` を用い、保存先のストレージ状態を厳密に検証し、ファイル破損のリスクを極限まで排除する「堅牢な保存シーケンス」を伝授する。

1. なぜ標準の `SaveAs` だけでは不十分なのか

PowerPointの保存処理は、内部的に巨大な一時ファイルを作成し、最後にリネームして確定させるという挙動を取る。このため、以下のリスクが常に付き纏う。

1. サイレント・ディスクフル: 空き容量がギリギリの場合、書き込み途中で容量が尽き、ファイルが不完全な状態で閉じられる。
2. ネットワーク・レイテンシの罠: NASへの直接保存は、パケットロスやタイムアウトの影響を直接受ける。書き込み時間が長ければ長いほど、切断リスクは高まる。
3. 不透明なエラーハンドリング: `SaveAs` が失敗したとき、それが「容量不足」なのか「権限不足」なのか「ネットワーク断」なのかをVBA側で判別する術はほぼない。

結論：保存ボタンを押す前に、「書き込める確証」を得る設計にせよ。

2. アーキテクチャ設計：防御的保存シーケンス

私が推奨するプロフェッショナルな保存フローは以下の通りだ。

構成フロー

1. パスの正当性検証: フォルダが存在し、書き込み権限があるかを確認。
2. 空き容量の厳密チェック: `GetDiskFreeSpaceEx` APIを用い、バイト単位で空き容量を取得。
3. 安全マージンの計算: 現在のプレゼンテーションサイズから想定保存サイズを算出し、その1.5倍〜2倍の空き容量があるかを確認。
4. アトミック保存戦略（オプション）: ネットワーク不安定環境では、一度ローカルの `%TEMP%` に保存し、その後 `FileSystemObject` でNASへムーブする（これによりNASへの書き込み時間を最短化し、破損リスクを下げる）。

3. 実装コード：極限の堅牢保存マクロ

以下に、64bit/32bit両対応のプロダクションコードを示す。単なるコピペではなく、APIの型定義とエラーハンドリングの構造を注視してほしい。

Option Explicit

' --- Windows API Definitions ---
' GetDiskFreeSpaceExW: Unicode版を使用し、大容量ディスク(2TB超)にも対応
If VBA7 Then
    Private Declare PtrSafe Function GetDiskFreeSpaceExW _
        Lib "kernel32" Alias "GetDiskFreeSpaceExW" ( _
        ByVal lpDirectoryName As LongPtr, _
        ByRef lpFreeBytesAvailableToCaller As Currency, _
        ByRef lpTotalNumberOfBytes As Currency, _
        ByRef lpTotalNumberOfFreeBytes As Currency) As Long
Else
    Private Declare Function GetDiskFreeSpaceExW _
        Lib "kernel32" Alias "GetDiskFreeSpaceExW" ( _
        ByVal lpDirectoryName As Long, _
        ByRef lpFreeBytesAvailableToCaller As Currency, _
        ByRef lpTotalNumberOfBytes As Currency, _
        ByRef lpTotalNumberOfFreeBytes As Currency) As Long
End If

' 文字列をUnicode形式で扱うための定数
Private Const UNICODE_ENCODING As Long = 1

''' <summary>
''' 保存先のストレージ状態を検証し、安全に保存を実行する。
''' </summary>
''' <param name="targetPath">保存先のフルパス（ファイル名含む）</param>
Public Sub RobustSavePresentation(ByVal targetPath As String)
    On Error GoTo ErrorHandler
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim folderPath As String
    folderPath = fso.GetParentFolderName(targetPath)
    
    ' 1. フォルダの存在確認
    If Not fso.FolderExists(folderPath) Then
        Err.Raise vbObjectError + 513, "RobustSave", "保存先フォルダが存在しません: " & folderPath
    End If
    
    ' 2. 空き容量の検証
    Dim freeBytes As Currency
    Dim totalBytes As Currency
    Dim availableBytes As Currency
    
    ' API呼び出し。パスをUnicode文字列として渡す
    If GetDiskFreeSpaceExW(StrPtr(folderPath), freeBytes, totalBytes, availableBytes) = 0 Then
        Err.Raise vbObjectError + 514, "RobustSave", "ディスク容量の取得に失敗しました。ネットワーク接続を確認してください。"
    End If
    
    ' 3. 必要容量の推定と検証
    ' 現在のファイルサイズを基準に、安全係数 2.0 を乗算（一時ファイルの作成分を考慮）
    Dim currentFileSize As LongPtr
    Dim estimatedRequiredBytes As Currency
    
    ' 保存済みファイルがある場合はそのサイズを、ない場合は暫定的に50MBとして計算
    If fso.FileExists(targetPath) Then
        currentFileSize = fso.GetFile(targetPath).Size
    Else
        currentFileSize = 50 * 1024 * 1024 ' 50MB default
    End If
    
    estimatedRequiredBytes = CCur(currentFileSize) * 2
    
    If freeBytes < estimatedRequiredBytes Then
        Err.Raise vbObjectError + 515, "RobustSave", _
            "空き容量が不足しています。" & vbCrLf & _
            "必要推定量: " & Format(estimatedRequiredBytes / 1024 / 1024, "#,##0") & " MB" & vbCrLf & _
            "現在空き量: " & Format(freeBytes / 1024 / 1024, "#,##0") & " MB"
    End If
    
    ' 4. 保存実行（アトミック保存戦略）
    ' 直接NASに書き込むのではなく、一度ローカルTEMPに保存してムーブする
    Dim tempPath As String
    tempPath = Environ("TEMP") & "\" & fso.GetFileName(targetPath)
    
    Debug.Print "Saving to temporary local path: " & tempPath
    
    ' PowerPointの保存処理
    ActivePresentation.SaveAs tempPath, ppSaveAsDefault
    
    ' ローカルからNASへ移動（これが最も高速かつ安全な転送手段）
    If fso.FileExists(targetPath) Then fso.DeleteFile targetPath, True
    fso.MoveFile tempPath, targetPath
    
    MsgBox "保存が正常に完了しました。", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox "【致命的エラー】保存処理を中断しました。" & vbCrLf & _
           "エラー番号: " & Err.Number & vbCrLf & _
           "内容: " & Err.Description, vbCritical, "System Error"
    ' 暫定ファイルが残っていた場合は削除
    If Not fso Is Nothing Then
        Dim tempPathCleanup As String
        tempPathCleanup = Environ("TEMP") & "\" & fso.GetFileName(targetPath)
        If fso.FileExists(tempPathCleanup) Then fso.DeleteFile tempPathCleanup, True
    End If
End Sub

4. 技術的深掘り：ここが「プロ」の視点

なぜ `Currency` 型を使うのか？

`GetDiskFreeSpaceEx` が返す値は `ULARGE_INTEGER`（64bit無符号整数）だ。VBAの `Long` は32bitであり、2GB以上のディスク容量を扱うとオーバーフローする。
VBAで64bit整数を扱う最も安定した方法は `Currency` 型（8バイト固定小数点数）へのマッピングだ。これにより、テラバイト級のストレージ容量を精度良く取得できる。

「ローカル保存 $\rightarrow$ ムーブ」の合理的理由

ネットワークドライブへの直接保存は、OSレベルで「小さな書き込み要求」を大量に発行する。NASはこのオーバーヘッドに弱く、通信遅延が発生するとOffice側がタイムアウト判定を下し、ファイル破損を招く。
一方、`fso.MoveFile`（内部的には `MoveFileEx` API）は、ファイルシステムレベルでの最適化された転送を行うため、書き込み時間が劇的に短縮され、ネットワーク断のリスクを最小限に抑えられる。

計算上の安全マージン

なぜ `currentFileSize * 2` なのか。
PowerPointの保存プロセスでは、「元のファイル」を維持したまま「新しい一時ファイル」を作成し、最後に置換するという挙動を取るためだ。つまり、一瞬だけ「ファイル2個分」の容量を消費する。ここを考慮しない設計は、容量ギリギリのNAS環境で確実にクラッシュする。

5. まとめ：ツール開発者に求められる「疑い」の精神

「`SaveAs` メソッドがあるから、それで十分だ」と考えるのは、単なるプログラマーだ。
「NAS環境ではいつ切断されるか分からない。ディスク容量が尽きたときにどう振る舞うか」までを設計に盛り込むのが、アーキテクトである。

堅牢なコードとは、正常系を動かすコードではなく、異常系をいかに優雅に、かつ確実に制御するかによって定義される。

この設計思想を、あなたの全ての自動化ツールに適用してほしい。