I/Oの死角を制する：Windows APIを用いた動的ディスク容量管理と画像ダウンサンプリングによる堅牢なPowerPoint自動化
業務自動化の現場において、最も「初歩的かつ致命的」なエラーは何か。それは、コードのロジックミスではない。「環境の物理的制約」を無視した設計だ。
数百枚のプレゼンテーションを、高解像度の画像を含んだ状態で一括生成・保存するバッチ処理を考えてみろ。コードは完璧に見える。ロジックも数学的に正しい。しかし、保存先のネットワークドライブや、容量の逼迫したエッジデバイスにおいて、`SaveAs` メソッドが突如として `Err.Number = 70 (Permission Denied)` や `Err.Number = 76 (Path not found)`、あるいは不可解な書き込み失敗を吐いて停止する。これは多くの場合、ディスク容量の枯渇が原因である。
シニアエンジニアであれば、`On Error Resume Next` でエラーを握りつぶすような真似はしない。エラーが起きる前に、OSの低レイヤーにアクセスして状況を検知し、動的にリソース消費を最適化する。それがプロフェッショナルの設計思想だ。
本稿では、Windows APIを用いてディスクの空き容量を精密に取得し、容量不足が予見される場合に、スライド内の高解像度画像を自動的にダウンサンプリング（圧縮）して保存する、極限の堅牢性を備えたアーキテクチャを解説する。
1. 低レイヤーへのアクセス：`GetDiskFreeSpaceExW` の採用
VBAの `FileSystemObject` は使い勝手が良いが、大量のデータを扱う際の精密さや、64bit環境下での巨大なディスク容量（TB級）を扱う際の堅牢性においては、Windows APIに軍配が上がる。
ここで使用するのは `GetDiskFreeSpaceExW` だ。従来の `GetDiskFreeSpace` とは異なり、バイト単位での正確な空き容量を、Unicode文字列（Wide char）を用いて取得できる。
API宣言と実装
VBAにおける `ULARGE_INTEGER`（64bit整数）の扱いは厄介だ。VBAには64bit整数型が存在しないため、2つの `Long` 型に分割して受ける必要がある。この「型変換の作法」を知っているかどうかが、設計の解像度を分ける。
Option Explicit
' Windows API の宣言
' GetDiskFreeSpaceExW を使用して、Unicodeパスに対して正確な容量を取得する
Private Declare PtrSafe Function GetDiskFreeSpaceExW Lib "kernel32" ( _
ByVal lpDirectoryName As LongPtr, _
ByRef lpFreeBytesAvailableToCaller As Currency, _
ByRef lpTotalNumberOfBytes As Currency, _
ByRef lpTotalNumberOfFreeBytes As Currency) As Long
''' <summary>
''' 指定したパスの空き容量をバイト単位で取得する
''' </summary>
''' <param name="folderPath">チェック対象のディレクトリパス</param>
''' <returns>空き容量（バイト）</returns>
Private Function GetFreeDiskSpace(ByVal folderPath As String) As Currency
Dim lpFreeBytes As Currency
Dim lpTotalBytes As Currency
Dim lpTotalFreeBytes As Currency
Dim result As Long
' 文字列をUnicode（Wide char）に変換してAPIに渡す
' VBAのStringは内部的にUnicodeだが、API呼び出しには適切な変換が必要
result = GetDiskFreeSpaceExW(StrPtr(folderPath), lpFreeBytes, lpTotalBytes, lpTotalFreeBytes)
If result <> 0 Then
GetFreeDiskSpace = lpFreeBytes
Else
' エラーハンドリング：API呼び出し失敗時は0を返す
GetFreeDiskSpace = 0
End If
End Function*注：ここでは `Currency` 型を使用している。`Currency` は15桁の精度を持つため、VBAでバイト単位の巨大な数値を扱う際のデファクトスタンダードだ。*
2. 戦略的リソース管理：画像ダウンサンプリング・アルゴリズム
容量が不足していると判断した場合、我々は「情報の密度」を操作する。プレゼンテーションの文脈において、最も容量を食いつぶすのは `Shape.Type = msoPicture` のオブジェクトだ。
単に `ScaleHeight` でサイズを小さくするだけでは、内部のXML構造に保持されているバイナリデータ（画像そのもの）は圧縮されない。真のダウンサンプリングとは、「高解像度画像を一度ビットマップとして書き出し、低解像度で再インポートする」というプロセスを指す。
破壊的再構成による圧縮ロジック
このプロセスでは、メモリリークを防ぐための明示的なオブジェクト解放が不可欠だ。
''' <summary>
''' スライド内の全画像を、指定した品質でダウンサンプリングする
''' </summary>
''' <param name="pres">対象のPresentationオブジェクト</param>
''' <param name="targetScale">縮小率 (0.1 ～ 1.0)</param>
Private Sub DownsampleAllImages(ByRef pres As Presentation, ByVal targetScale As Single)
Dim sld As Slide
Dim shp As Shape
Dim tempImgPath As String
Dim newImg As Shape
Dim leftPos As Single, topPos As Single
Dim widthVal As Single, heightVal As Single
' 一時ファイルのパス（環境依存を避けるためTempフォルダを使用）
tempImgPath = Environ("TEMP") & "\ppt_temp_img.jpg"
' 画面更新を停止してパフォーマンスを稼ぐ（ただし、再描画が必要な場合は注意）
' PowerPointにはExcelのようなScreenUpdatingがないため、描画プロセスを制御するには
' 慎重なオブジェクト操作が求められる
For Each sld In pres.Slides
' スライド内の図形を逆順にループ（削除・追加時のインデックスずれを防ぐため）
For i = sld.Shapes.Count To 1 Step -1
Set shp = sld.Shapes(i)
' 画像オブジェクトのみを対象とする
If shp.Type = msoPicture Or shp.Type = msoLinkedPicture Then
' 現在のプロパティを退避
leftPos = shp.Left
topPos = shp.Top
widthVal = shp.Width * targetScale
heightVal = shp.Height * targetScale
' 1. 画像を一旦ファイルとしてエクスポート（これが実質的なダウンサンプリング）
' Exportメソッドは指定した解像度で出力可能
shp.Export tempImgPath, ppShapeFormatJPG
' 2. 元の画像を削除
shp.Delete
' 3. 圧縮された画像を再挿入
Set newImg = sld.Shapes.AddPicture(FileName:=tempImgPath, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=leftPos, _
Top:=topPos, _
Width:=widthVal, _
Height:=heightVal)
' 4. オブジェクトの解放（メモリの断片化防止）
Set newImg = Nothing
End If
Set shp = Nothing
Next i
Next sld
' 後処理
If Dir(tempImgPath) <> "" Then Kill tempImgPath
End Sub3. オーケストレーション：統合された保存エンジン
最後に、これらを統合した「スマート・セービング・エンジン」を構築する。ここでは、「予測的チェック」に基づいた条件分岐を実装する。
''' <summary>
''' ストレージ容量を考慮したインテリジェントな保存処理
''' </summary>
''' <param name="pres">対象のPresentation</param>
''' <param name="savePath">保存先フルパス</param>
Public Sub SmartSave(ByRef pres As Presentation, ByVal savePath As String)
Dim folderPath As String
Dim freeSpace As Currency
Dim requiredSpace As Currency
Dim thresholdRatio As Double
' 保存先ディレクトリの取得
folderPath = Left(savePath, InStrRev(savePath, "\"))
' 閾値設定：空き容量がファイル予想サイズの10%未満、
' もしくは絶対値として500MBを切る場合に圧縮モードへ移行
' ここでは簡略化のため「空き容量が200MBを切ったら強制圧縮」とする
Const MIN_SAFE_SPACE As Currency = 200 * 1024 * 1024 ' 200MB
' 1. ディスク容量のチェック
freeSpace = GetFreeDiskSpace(folderPath)
If freeSpace = 0 Then
Err.Raise vbObjectError + 513, "SmartSave", "ストレージ情報の取得に失敗しました。"
End If
' 2. 戦略的判断
If freeSpace < MIN_SAFE_SPACE Then
Debug.Print "Warning: Low disk space detected (" & Format(freeSpace / 1024 / 1024, "0.0") & " MB). Initiating compression..."
' 画像を50%にダウンサンプリングして容量を削減
DownsampleAllImages pres, 0.5
End If
' 3. 保存実行
On Error GoTo SaveError
pres.SaveAs Filename:=savePath
Debug.Print "Success: Presentation saved to " & savePath
Exit Sub
SaveError:
' 致命的な書き込みエラーが発生した場合の最終防衛ライン
MsgBox "致命的なエラー: 保存に失敗しました。" & vbCrLf & _
"Error No: " & Err.Number & vbCrLf & _
"Description: " & Err.Description, vbCritical, "Storage Error"
' ここでログ出力やシステム管理者への通知ロジックを走らせるのが理想的
End Sub結論：アーキテクトの視点
この実装が、単なる「便利ツール」と「プロフェッショナルなシステム」を分ける境界線だ。
1. 予測可能性 (Predictability): エラーが起きてから対処するのではなく、エラーの予兆（容量不足）を検知して、動作を動的に変更している。
2. リソースの抽象化 (Abstraction): `SaveAs` という高レベルな抽象概念の背後にある、物理的なディスク容量という現実を直視している。
3. メモリの規律 (Memory Discipline): `Set shp = Nothing` による明示的な解放は、長時間稼働する自動化プロセスにおけるメモリリークを防ぐための最低限の礼儀である。
レガシーなVBA環境であっても、Windows APIを介してOSの挙動を制御する手法は変わらない。システム間の連携、大規模データのバッチ処理、そして予期せぬハードウェア制約。これらに立ち向かうには、言語の構文を知るだけでなく、その下層で何が起きているかを理解していなければならない。
君のコードは、環境の制約に屈するか、それとも環境を支配するか。選択は君次第だ。
