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

スポンサーリンク
スポンサーリンク

ネットワーク越しの死を回避せよ：GetDiskFreeSpaceExによるPowerPoint保存処理の極限的堅牢化

エンタープライズ領域における業務自動化において、最も忌むべき事態は「エラーによる停止」ではない。「エラーによるデータの不整合（ファイル破損）」である。

特に、数千枚規模のスライドや、高解像度のメディアを大量に含むプレゼンテーションを、ネットワークドライブ（NAS）や共有ストレージへ自動保存するシナリオでは、このリスクは指数関数的に増大する。保存の最中にネットワークの瞬断が発生した、あるいは書き込み中にディスク容量が枯渇した。その瞬間、元のファイルは破壊され、ユーザーの資産は霧散する。

標準的な `Presentation.SaveAs` メソッドを過信してはならない。それは「ストレージが常に安定しており、容量が無限にある」という楽観的な前提の上に成り立つ、脆い抽象化レイヤーに過ぎない。

本稿では、Windows APIを用いた低レイヤーでのストレージ検証と、ファイル破損を物理的に回避する「ローカル・バッファ・コミット」戦略について、その極限の知見を共有する。

1. なぜ `FileSystemObject` では不十分なのか

VBAエンジニアの多くは、`Scripting.FileSystemObject` (FSO) を用いて空き容量を確認しようとする。しかし、シニアエンジニアであれば、その限界を理解しているはずだ。

FSOの `FreeSpace` プロパティは、OSが提供する高レベルな抽象化に基づいている。ネットワークドライブ、特にSMBプロトコルを介したNAS環境においては、OSのキャッシュ層やファイルシステムの挙動により、正確な「利用可能なバイト数」を返さないケースがある。

我々が求めるのは、「そのプロセスが実際に書き込める、物理的な限界値」だ。そのためには、`kernel32.dll` に直接問い合わせ、OSのカーネルレベルで管理されているディスク情報を取得する `GetDiskFreeSpaceEx` APIの使用が不可欠となる。

2. Windows APIによるストレージ・プロファイリング

まず、64bit/32bit両環境に対応した、堅牢なAPI宣言から始める。ここで重要なのは、容量（Bytes）を格納するための型選択だ。64bit環境の巨大なディスク容量を扱うため、VBAでは `Currency` 型を介して64bit整数を扱うテクニックを用いる。

Option Explicit

' Windows API: ディスクの空き容量および総容量を取得
' GetDiskFreeSpaceEx は UNCパス（\\Server\Share）にも対応している

If VBA7 Then

    Private Declare PtrSafe Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" ( _
        ByVal lpDirectoryName As String, _
        ByRef lpFreeBytesAvailableToCaller As Currency, _
        ByRef lpTotalNumberOfBytes As Currency, _
        ByRef lpTotalNumberOfFreeBytes As Currency) As Long

Else

    Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" ( _
        ByVal lpDirectoryName As String, _
        ByRef lpFreeBytesAvailableToCaller As Currency, _
        ByRef lpTotalNumberOfBytes As Currency, _
        ByRef lpTotalNumberOfFreeBytes As Currency) As Long

End If


''' <summary>
''' 指定されたパスの空き容量（バイト）を返します。
''' </summary>
''' <param name="targetPath">ディレクトリまたはUNCパス</param>
''' <returns>空き容量(Byte)。エラー時は -1</returns>
Private Function GetAvailableFreeSpace(ByVal targetPath As String) As Double
    Dim freeBytesAvailable As Currency
    Dim totalBytes As Currency
    Dim totalFreeBytes As Currency
    Dim result As Long

    ' パスの末尾にバックスラッシュがない場合、APIの挙動を安定させるために付与
    If Right(targetPath, 1) <> "\" Then targetPath = targetPath & "\"

    ' API呼び出し
    result = GetDiskFreeSpaceEx(targetPath, freeBytesAvailable, totalBytes, totalFreeBytes)

    If result <> 0 Then
        ' Currency型からDoubleへ変換して精度を維持
        GetAvailableFreeSpace = CDbl(freeBytesAvailable)
    Else
        GetAvailableFreeSpace = -1
    End If
End Function

3. 堅牢な保存シーケンス：Atomic Save Pattern

次に、設計思想を定義する。ネットワーク越しに直接 `SaveAs` を実行することは、爆弾を抱えて歩くようなものだ。

我々が採用すべきは、「Local-First, Then Move」戦略である。

1. Pre-flight Check: 保存先パスの存在確認と、APIによる空き容量の検証。
2. Capacity Validation: `(現在のファイルサイズ * 1.5) + 安全バッファ` が空き容量にあるかを確認。
3. Local Buffer Write: 一旦、ローカルの `TEMP` ディレクトリに保存する。これにより、書き込み中のネットワーク切断によるファイル破損を物理的に遮断する。
4. Atomic Move: ローカルでの保存が成功したことを確認した後、`FileSystemObject` の `MoveFile` もしくは `ReplaceFile`（API）を用いて、NASへ転送する。

4. 実装例：プロフェッショナル・セーブ・エンジンの構築

以下に、これらの知見を統合した、実戦投入可能なクラスモジュール級のコードを示す。

' --- Module: RobustSaveEngine ---

''' <summary>
''' ネットワークドライブへの安全な保存を実行する
''' </summary>
''' <param name="pres">保存対象のPresentationオブジェクト</param>
''' <param name="targetPath">保存先のフルパス</param>
Public Sub SafeSaveAs(ByRef pres As Presentation, ByVal targetPath As String)
    Dim fso As Object
    Dim tempFilePath As String
    Dim targetDir As String
    Dim requiredSpace As Double
    Dim availableSpace As Double
    Dim fileExt As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    targetDir = fso.GetParentFolderName(targetPath)
    fileExt = fso.GetExtensionName(targetPath)
    
    ' 1. 保存先ディレクトリの存在確認
    If Not fso.FolderExists(targetDir) Then
        Err.Raise vbObjectError + 513, "RobustSaveEngine", "保存先ディレクトリが存在しません: " & targetDir
    End If

    ' 2. APIを用いた空き容量の検証
    availableSpace = GetAvailableFreeSpace(targetDir)
    If availableSpace <= 0 Then
        Err.Raise vbObjectError + 514, "RobustSaveEngine", "ネットワークドライブへのアクセスに失敗しました。"
    End If

    ' 3. 必要容量の計算 (ファイルサイズ + 50%の安全マージン)
    ' ※PowerPointの保存時は一時ファイルが作成されるため、余裕を持たせる
    requiredSpace = pres.FullSaveSize * 1.5 
    
    If availableSpace < requiredSpace Then
        Err.Raise vbObjectError + 515, "RobustSaveEngine", _
            "容量不足です。必要: " & Format(requiredSpace, "#,##0") & " B, 空き: " & Format(availableSpace, "#,##0") & " B"
    End If

    ' 4. ローカルTempへの一時保存
    tempFilePath = Environ("TEMP") & "\" & fso.GetBaseName(targetPath) & "_" & Format(Now, "yyyymmddhhnnss") & "." & fileExt
    
    On Error GoTo ErrorHandler
    pres.SaveCopyAs tempFilePath ' 元のプレゼンテーションを汚さないようSaveCopyAsを使用
    
    ' 5. ローカル保存成功後、ターゲットへ移動（上書き）
    ' ファイルが既に存在する場合は削除してから移動
    If fso.FileExists(targetPath) Then
        fso.DeleteFile targetPath, True
    End If
    fso.MoveFile tempFilePath, targetPath

    ' オブジェクトの明示的解放
    Set fso = Nothing
    Debug.Print "Success: " & targetPath
    Exit Sub

ErrorHandler:
    ' 一時ファイルが残っている場合は掃除
    If fso.FileExists(tempFilePath) Then fso.DeleteFile tempFilePath, True
    Set fso = Nothing
    Err.Raise Err.Number, "RobustSaveEngine", "保存シーケンス中に致命的なエラーが発生しました: " & Err.Description
End Sub

5. メモリ管理とオブジェクトのライフサイクル

このレベルの自動化を実装する場合、メモリリークは致命的な欠陥となる。特に大量のファイルをループ処理する場合、`FileSystemObject` や `Presentation` オブジェクトの解放を怠ると、VBAのメモリ空間が断片化し、最終的に `Out of Memory` を引き起こす。

  • 明示的な `Set obj = Nothing`: スコープを抜ける前に必ず実行すること。
  • `SaveCopyAs` の選択: `SaveAs` は現在のオブジェクトの状態を書き換えてしまう。自動化プロセスにおいて、現在の状態を維持したままバックアップ的に保存したい場合は、`SaveCopyAs` を使用するのがアーキテクチャとして正しい。
  • Error Handling: `On Error GoTo` を用いたクリーンアップ処理は必須だ。エラー発生時に `TEMP` ディレクトリにゴミを残すことは、システムの「不潔さ」を意味する。

結論

プロフェッショナルなエンジニアリングとは、単に「動くコード」を書くことではない。「動かなくなる条件」を想定し、それをコードによって封じ込めることだ。

`GetDiskFreeSpaceEx` による低レイヤーの検証、そしてローカルバッファを経由するアトミックな保存戦略。これらを組み合わせることで、初めてネットワークという不安定な戦場においても、信頼に足る自動化システムを構築することができる。

技術の深淵を覗き、常に最悪の事態に備えよ。

スポンサーリンク
タイトルとURLをコピーしました