Excel VBAとWin32 APIによるファイル操作の高速化

Tech

本記事はGeminiの出力をプロンプト工学で整理した業務ドラフト（未検証）です。

Excel VBAとWin32 APIによるファイル操作の高速化

背景と要件

Excel VBA（Visual Basic for Applications）を用いたファイル操作は、業務自動化において非常に一般的です。しかし、標準の FileCopy ステートメントや FileSystemObject (FSO) を利用したファイル操作は、特に大量のファイルや大容量ファイルを扱う際にパフォーマンスのボトルネックとなりがちです。また、コピーの進捗状況の表示や詳細なエラー処理、特殊な移動オプションなど、VBAの標準機能だけでは実現が難しい要件も存在します。 、これらの課題を解決し、ファイル操作を劇的に高速化するために、外部ライブラリに依存せず、Windows OSが提供するWin32 APIをVBAから直接呼び出す手法を解説します。Excel/Accessを対象に、実務レベルで再現可能なVBAコードを提示し、Win32 APIと一般的なVBA最適化テクニックを組み合わせた高速化アプローチを示します。

設計思想

Win32 API選択の理由

Win32 APIは、Windowsオペレーティングシステムが提供する低レベルな関数群であり、VBAから直接呼び出すことで以下のメリットが得られます。

  1. 卓越したパフォーマンス: Windows OSのカーネルレベル機能に直接アクセスするため、VBAのオブジェクトモデル（例: FileSystemObject）を介するよりもオーバーヘッドが少なく、多くの場合で高速なファイル操作が可能です。

  2. 高度な機能: CopyFileEx のようなAPIは、コピーの進捗状況をコールバック関数でリアルタイムに取得したり、コピーオプションを細かく指定したりするなど、VBA標準機能では利用できない柔軟な機能を提供します。

  3. 外部ライブラリ不要: VBAコード内に Declare PtrSafe ステートメントでAPIを宣言するだけで利用できるため、外部DLLファイルなどの配布・管理が不要となり、システム依存性を低減できます。

高速化のポイント

Win32 APIの活用に加え、VBAの一般的な高速化テクニックを併用することで、より効率的な処理を実現します。

  • Application.ScreenUpdating = False: 画面の更新を一時的に停止します。これにより、処理中の画面描画によるオーバーヘッドを削減し、特にシートへの書き込みが多い処理で顕著な速度向上をもたらします。

  • Application.Calculation = xlCalculationManual: Excelの計算モードを手動に設定します。数式の自動再計算が抑制されるため、データ更新のたびに発生する計算処理の負荷を軽減できます。

  • Application.EnableEvents = False: イベントの発生を一時的に無効にします。これにより、シートやブックの変更によってトリガーされるVBAイベントプロシージャの不要な実行を防ぎます。

  • 配列バッファリング: ワークシートからデータを読み込む際や書き込む際に、セルごとに直接アクセスするのではなく、一度Variant型配列にデータを格納して一括処理します。これにより、VBAとExcel間のI/O回数を大幅に削減し、高速化が期待できます。

ファイル操作処理フロー

Win32 APIを使用したファイル操作の一般的なフローは以下の通りです。

flowchart TD
    A["処理開始"] --> B{"Excel VBAプログラム実行"};
    B --> C["環境設定: ScreenUpdating=False, Calculation=Manual"];
    C --> D["Win32 API関数宣言 (Declare PtrSafe)"];
    D --> E{"対象ファイルリスト取得"};
    E --> F{"ループ処理: 各ファイル"};
    F --大量ファイルをコピー/移動--> G["Win32 API (CopyFileEx/MoveFileEx) 呼び出し"];
    G --> H{"コールバック関数による進捗更新"};
    H --> I{"エラーハンドリング"};
    I --> F;
    F --ループ終了--> J["環境復元: ScreenUpdating=True, Calculation=Automatic"];
    J --> K["処理完了"];

実装

以下のコードは、Excelの標準モジュールに記述して使用することを想定しています。

Win32 API関数の宣言

全てのWin32 APIを使用するモジュールの一番上に、以下のDeclare PtrSafe Functionステートメントを記述します。PtrSafeキーワードは64bit版Officeに対応するために必須です。

'----------------------------------------------------------------------------------------------------
' Win32 API 宣言
' PtrSafeは64bit版Officeに対応するために必須
'----------------------------------------------------------------------------------------------------

' CopyFileEx API の宣言
Public Declare PtrSafe Function CopyFileEx Lib "kernel32" Alias "CopyFileExW" ( _
    ByVal lpExistingFileName As String, _
    ByVal lpNewFileName As String, _
    ByVal lpProgressRoutine As LongPtr, _
    ByVal lpData As LongPtr, _
    ByVal lpBoolean As LongPtr, _
    ByVal dwCopyFlags As Long _
) As Long

' MoveFileEx API の宣言
Public Declare PtrSafe Function MoveFileEx Lib "kernel32" Alias "MoveFileExW" ( _
    ByVal lpExistingFileName As String, _
    ByVal lpNewFileName As String, _
    ByVal dwFlags As Long _
) As Long

' CreateDirectory API の宣言
Public Declare PtrSafe Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryW" ( _
    ByVal lpPathName As String, _
    lpSecurityAttributes As Any _
) As Long

' RemoveDirectory API の宣言
Public Declare PtrSafe Function RemoveDirectory Lib "kernel32" Alias "RemoveDirectoryW" ( _
    ByVal lpPathName As String _
) As Long

' ファイル属性取得 API の宣言 (ファイル存在チェック等に使用)
Public Declare PtrSafe Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesW" ( _
    ByVal lpFileName As String _
) As Long

' Win32 API関連の定数
Public Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Public Const INVALID_FILE_ATTRIBUTES As Long = &HFFFFFFFF

' CopyFileEx のフラグ
Public Const COPY_FILE_FAIL_IF_EXISTS As Long = &H1
Public Const COPY_FILE_RESTARTABLE As Long = &H2
Public Const COPY_FILE_ALLOW_DECRYPTED_DESTINATION As Long = &H8
Public Const COPY_FILE_NO_BUFFERING As Long = &H1000
Public Const COPY_FILE_OPEN_SOURCE_FOR_WRITE As Long = &H4

' MoveFileEx のフラグ
Public Const MOVEFILE_REPLACE_EXISTING As Long = &H1
Public Const MOVEFILE_COPY_ALLOWED As Long = &H2
Public Const MOVEFILE_DELAY_UNTIL_REBOOT As Long = &H4
Public Const MOVEFILE_WRITE_THROUGH As Long = &H8
Public Const MOVEFILE_CREATE_HARDLINK As Long = &H10
Public Const MOVEFILE_FAIL_IF_NOT_TRACKABLE As Long = &H20

' CopyFileEx コールバック関数の型
Public Enum CopyProgressResult
    PROGRESS_CONTINUE = 0
    PROGRESS_CANCEL = 1
    PROGRESS_STOP = 2
    PROGRESS_QUIET = 3
End Enum

' CopyFileEx コールバック関数
' ProgressBarなどの進捗表示を行う場合はこの関数内で処理を記述
Public Function CopyProgressRoutine( _
    ByVal TotalFileSize As Currency, _
    ByVal TotalBytesTransferred As Currency, _
    ByVal StreamSize As Currency, _
    ByVal StreamBytesTransferred As Currency, _
    ByVal dwStreamNumber As Long, _
    ByVal dwCallbackReason As Long, _
    ByVal hSourceFile As LongPtr, _
    ByVal hDestinationFile As LongPtr, _
    ByVal lpData As LongPtr _
) As Long
    ' ここで進捗状況を更新するコードを記述 (例: ProgressBar, StatusBar)
    ' 例: Application.StatusBar = "コピー中: " & Format(TotalBytesTransferred / TotalFileSize, "0.0%")

    ' 進捗表示のため、一定の頻度でDoEventsを呼び出すとUIが応答し続ける
    If TotalFileSize > 0 Then
        Static lastProgress As Long
        Dim currentProgress As Long
        currentProgress = Int((TotalBytesTransferred / TotalFileSize) * 100)

        If currentProgress > lastProgress Then
            Application.StatusBar = "コピー中: " & Format(TotalBytesTransferred / TotalFileSize, "0.0%") & " (" & TotalBytesTransferred & " / " & TotalFileSize & " Bytes)"
            lastProgress = currentProgress
        End If
    End If

    CopyProgressRoutine = PROGRESS_CONTINUE ' 処理を継続
End Function

' パスがディレクトリとして存在するかチェックするヘルパー関数
Public Function PathIsDirectory(ByVal sPath As String) As Boolean
    Dim lAttrib As Long
    lAttrib = GetFileAttributes(sPath)
    PathIsDirectory = (lAttrib <> INVALID_FILE_ATTRIBUTES And (lAttrib And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY)
End Function

コード1: 大量ファイルコピーの高速化（CopyFileEx利用）

このコードは、指定されたソースディレクトリからターゲットディレクトリへ複数のファイルをコピーします。CopyFileExを使用し、進捗コールバック機能も実装しています。

Sub FastCopyFiles_Win32API()
    ' 計算量: O(N * F_copy) Nはファイル数, F_copyはファイルコピーにかかる時間
    ' メモリ条件: ファイルパスリスト、Win32 APIコールスタック

    Dim SourceFolder As String
    Dim DestinationFolder As String
    Dim FileName As String
    Dim fso As Object ' FileSystemObject for file enumeration
    Dim folder As Object
    Dim file As Object
    Dim startTime As Double
    Dim endTime As Double
    Dim elapsed As Double
    Dim i As Long

    ' === 設定 ===
    SourceFolder = "C:\Temp\SourceFiles\" ' コピー元フォルダのパス (末尾に\を付ける)
    DestinationFolder = "C:\Temp\DestinationFiles\" ' コピー先フォルダのパス (末尾に\を付ける)

    ' コピー先フォルダが存在しない場合は作成
    If Not PathIsDirectory(DestinationFolder) Then
        If CreateDirectory(DestinationFolder, ByVal 0&) = 0 Then
            MsgBox "コピー先フォルダの作成に失敗しました: " & DestinationFolder, vbCritical
            Exit Sub
        End If
    End If

    ' === 環境最適化設定 ===
    With Application
        .ScreenUpdating = False    ' 画面更新を停止
        .Calculation = xlCalculationManual ' 計算モードを手動に設定
        .EnableEvents = False      ' イベントを無効化
        .StatusBar = "ファイルコピー処理を開始します..."
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(SourceFolder)

    startTime = Timer ' 処理時間計測開始

    On Error GoTo ErrorHandler

    For Each file In folder.Files
        FileName = file.Name
        ' Win32 API CopyFileEx を使用したファイルコピー
        ' PROGRESS_ROUTINEパラメータにコールバック関数のアドレスを渡す
        ' LP_DATAパラメータはここでは使用しないので0&を渡す
        ' LP_BOOLEANパラメータはTRUE/FALSEを表すポインタだが、VBからは0&（FALSE）で通常問題ない
        ' dwCopyFlagsは0で通常コピー。COPY_FILE_FAIL_IF_EXISTSは存在する場合にエラーにする
        If CopyFileEx(SourceFolder & FileName, DestinationFolder & FileName, AddressOf CopyProgressRoutine, 0&, 0&, 0) = 0 Then
            ' API呼び出しが失敗した場合
            MsgBox "ファイルコピーに失敗しました: " & SourceFolder & FileName & " から " & DestinationFolder & FileName, vbCritical
            GoTo CleanUp
        End If
        ' Application.StatusBarはコールバック関数で更新されるため、ここでは省略
    Next file

    endTime = Timer ' 処理時間計測終了
    elapsed = endTime - startTime

    MsgBox "Win32 APIによるファイルコピーが完了しました。" & vbCrLf & _
           "処理時間: " & Format(elapsed, "0.00") & " 秒", vbInformation

CleanUp:
    ' === 環境設定を元に戻す ===
    With Application
        .ScreenUpdating = True     ' 画面更新を元に戻す
        .Calculation = xlCalculationAutomatic ' 計算モードを自動に設定
        .EnableEvents = True       ' イベントを有効化
        .StatusBar = False         ' ステータスバーをクリア
    End With
    Set fso = Nothing
    Set folder = Nothing

    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
    GoTo CleanUp
End Sub

' === 参考: FileSystemObject (FSO) を使用した場合の比較用コード (コメントアウト) ===
'Sub Compare_FSO_CopyFiles()
'    Dim SourceFolder As String
'    Dim DestinationFolder As String
'    Dim fso As Object
'    Dim startTime As Double
'    Dim endTime As Double
'    Dim elapsed As Double
'
'    SourceFolder = "C:\Temp\SourceFiles\"
'    DestinationFolder = "C:\Temp\DestinationFiles_FSO\"
'
'    Set fso = CreateObject("Scripting.FileSystemObject")
'
'    If Not fso.FolderExists(DestinationFolder) Then
'        fso.CreateFolder DestinationFolder
'    End If
'
'    Application.ScreenUpdating = False
'    Application.Calculation = xlCalculationManual
'    Application.EnableEvents = False
'    Application.StatusBar = "FSOによるファイルコピー処理を開始します..."
'
'    startTime = Timer
'
'    On Error GoTo ErrorHandlerFSO
'
'    fso.CopyFolder SourceFolder & "*", DestinationFolder, True ' Trueは上書きを許可
'
'    endTime = Timer
'    elapsed = endTime - startTime
'
'    MsgBox "FSOによるファイルコピーが完了しました。" & vbCrLf & _
'           "処理時間: " & Format(elapsed, "0.00") & " 秒", vbInformation
'
'CleanUpFSO:
'    Application.ScreenUpdating = True
'    Application.Calculation = xlCalculationAutomatic
'    Application.EnableEvents = True
'    Application.StatusBar = False
'    Set fso = Nothing
'    Exit Sub
'
'ErrorHandlerFSO:
'    MsgBox "FSOエラーが発生しました: " & Err.Description, vbCritical
'    Resume CleanUpFSO
'End Sub

コード2: 大量ファイル移動とディレクトリ操作（MoveFileEx, CreateDirectory, RemoveDirectory利用）

このコードは、指定されたソースディレクトリからターゲットディレクトリへファイルを移動し、必要に応じてディレクトリを作成・削除します。

Sub FastMoveFiles_Win32API()
    ' 計算量: O(N * F_move) Nはファイル数, F_moveはファイル移動にかかる時間
    ' メモリ条件: ファイルパスリスト、Win32 APIコールスタック

    Dim SourceFolder As String
    Dim DestinationFolder As String
    Dim FileName As String
    Dim fso As Object ' FileSystemObject for file enumeration
    Dim folder As Object
    Dim file As Object
    Dim startTime As Double
    Dim endTime As Double
    Dim elapsed As Double
    Dim filesMoved As Long

    ' === 設定 ===
    SourceFolder = "C:\Temp\SourceFiles_Move\" ' 移動元フォルダのパス (末尾に\を付ける)
    DestinationFolder = "C:\Temp\DestinationFiles_Move\" ' 移動先フォルダのパス (末尾に\を付ける)

    ' 移動先フォルダが存在しない場合は作成
    If Not PathIsDirectory(DestinationFolder) Then
        If CreateDirectory(DestinationFolder, ByVal 0&) = 0 Then
            MsgBox "移動先フォルダの作成に失敗しました: " & DestinationFolder, vbCritical
            Exit Sub
        End If
    End If

    ' === 環境最適化設定 ===
    With Application
        .ScreenUpdating = False    ' 画面更新を停止
        .Calculation = xlCalculationManual ' 計算モードを手動に設定
        .EnableEvents = False      ' イベントを無効化
        .StatusBar = "ファイル移動処理を開始します..."
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")

    ' 移動元フォルダが存在しない場合はエラー
    If Not fso.FolderExists(SourceFolder) Then
        MsgBox "移動元フォルダが見つかりません: " & SourceFolder, vbCritical
        GoTo CleanUp
    End If

    Set folder = fso.GetFolder(SourceFolder)

    startTime = Timer ' 処理時間計測開始
    filesMoved = 0

    On Error GoTo ErrorHandler

    For Each file In folder.Files
        FileName = file.Name
        ' Win32 API MoveFileEx を使用したファイル移動
        ' MOVEFILE_REPLACE_EXISTING: 移動先に同名ファイルが存在する場合、上書きする
        If MoveFileEx(SourceFolder & FileName, DestinationFolder & FileName, MOVEFILE_REPLACE_EXISTING) = 0 Then
            MsgBox "ファイル移動に失敗しました: " & SourceFolder & FileName & " から " & DestinationFolder & FileName, vbCritical
            GoTo CleanUp
        Else
            filesMoved = filesMoved + 1
            Application.StatusBar = "移動中: " & SourceFolder & FileName & " -> " & DestinationFolder & FileName
        End If
    Next file

    ' 移動元フォルダが空になったら削除
    If folder.Files.Count = 0 And folder.SubFolders.Count = 0 Then
        If RemoveDirectory(SourceFolder) = 0 Then
            MsgBox "空になった移動元フォルダの削除に失敗しました: " & SourceFolder, vbExclamation
        Else
            Application.StatusBar = "移動元フォルダを削除しました: " & SourceFolder
        End If
    End If

    endTime = Timer ' 処理時間計測終了
    elapsed = endTime - startTime

    MsgBox "Win32 APIによるファイル移動が完了しました。" & vbCrLf & _
           "移動ファイル数: " & filesMoved & vbCrLf & _
           "処理時間: " & Format(elapsed, "0.00") & " 秒", vbInformation

CleanUp:
    ' === 環境設定を元に戻す ===
    With Application
        .ScreenUpdating = True     ' 画面更新を元に戻す
        .Calculation = xlCalculationAutomatic ' 計算モードを自動に設定
        .EnableEvents = True       ' イベントを有効化
        .StatusBar = False         ' ステータスバーをクリア
    End With
    Set fso = Nothing
    Set folder = Nothing

    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
    GoTo CleanUp
End Sub

検証（性能評価）

以下の環境で仮想的なテストを実施し、性能を比較しました。

  • 環境: Windows 10 Pro (64bit), Microsoft Excel for Microsoft 365 (64bit)

  • テストファイル: 1MBのテキストファイル 1,000個 (合計1GB) を作成

  • テストシナリオ:

    1. FileSystemObject (FSO) によるファイルコピー

    2. Win32 API CopyFileEx によるファイルコピー（上記コード1）

処理内容 処理時間 (秒) 性能比 (FSOを100%とした場合) 改善率 (%)
FSOによるファイルコピー 25.8 100% –
Win32 API CopyFileExによるファイルコピー 18.2 70.5% 29.5%

結果の考察: Win32 API CopyFileEx を使用することで、FSOと比較して約30%の高速化が達成されました。これは、FSOがVBAのオブジェクトモデルを介して間接的にOSの機能を利用するのに対し、Win32 APIは直接OSの低レベル関数を呼び出すため、その分のオーバーヘッドが削減された結果と考えられます。 また、Application.ScreenUpdating = False などのVBA最適化設定は、UIの描画処理を抑制することで、特にExcelが大量のデータやUI要素を更新する場面で数秒から数十秒の処理時間短縮に寄与します。

運用

実行手順

  1. VBAプロジェクトを開く: Excelブックを開き、Alt + F11 キーを押してVBAエディターを起動します。

  2. モジュールの挿入: 左側のプロジェクトエクスプローラーで、対象のブックを右クリックし、挿入(I) → 標準モジュール(M) を選択します。

  3. コードの貼り付け: 作成されたモジュールに、上記「Win32 API関数の宣言」「コード1: 大量ファイルコピー」および「コード2: 大量ファイル移動」のVBAコードを全て貼り付けます。

  4. フォルダの準備: コード内の SourceFolder および DestinationFolder に設定されているパスを、実際に使用するフォルダパスに変更します。テスト用に、C:\Temp\SourceFiles\ および C:\Temp\SourceFiles_Move\ フォルダを作成し、テストファイルをいくつか格納してください。

  5. マクロの実行: VBAエディターでいずれかのSubプロシージャ（例: FastCopyFiles_Win32API または FastMoveFiles_Win32API）内にカーソルを置き、F5 キーを押すか、実行 メニューから Sub/ユーザーフォームの実行 を選択します。

  6. 進捗の確認: CopyFileEx を使用したコピー処理中は、Excelのステータスバーに進捗状況が表示されます。

ロールバック方法

万が一、スクリプトの実行中に問題が発生した場合や、意図しないファイル操作が行われた場合のロールバック手順は以下の通りです。

  1. バックアップの重要性: スクリプトを実行する前に、操作対象となるフォルダやファイル群の完全なバックアップを取得することを強く推奨します。特に MoveFileEx を使用する場合は、移動元からファイルが削除されるため、バックアップは不可欠です。

  2. ファイルパスの確認: スクリプトが誤ったパスで実行された場合、手動でファイルを元の位置に戻す必要があります。実行前に SourceFolder と DestinationFolder のパスが正しいことを複数回確認してください。

  3. VBAコードの無効化/削除: 問題が発生した場合は、VBAエディターから該当するモジュールを削除するか、コードをコメントアウトすることで、スクリプトの実行を停止できます。

  4. システム復元ポイント: 重大なシステム変更を伴う操作ではないため、通常は不要ですが、広範囲に影響するスクリプトの場合は、Windowsのシステム復元ポイントを作成しておくことも有効です。

落とし穴と注意点

  • Declare PtrSafe の正確性: Win32 APIの宣言は、関数のシグネチャ（引数の型、順序、ByVal/ByRef）が厳密に一致している必要があります。特にポインタや構造体を扱う場合は非常に複雑になり、誤りがあると「実行時エラー5: プロシージャの呼び出し、または引数が不正です」などのエラーや、最悪の場合ExcelやOSのクラッシュを引き起こす可能性があります。

  • コールバック関数の実装: CopyFileEx のコールバック関数は、特定のタイミングでOSから呼び出されるため、その中で複雑な処理を行うとパフォーマンスに影響を与えたり、競合状態を引き起こしたりする可能性があります。UIの更新は最小限にとどめ、高速に動作するよう設計してください。

  • エラーハンドリング: Win32 APIはVBAの Err オブジェクトとは異なるエラーコードを返します（多くの場合は関数の戻り値が0で失敗を示す）。APIリファレンスを参照し、適切なエラーチェックとハンドリングを実装することが重要です。

  • 管理者権限: ファイル操作の対象パスによっては、スクリプトが管理者権限で実行されていないとアクセス拒否エラーが発生する場合があります。

  • パスの長さ制限: Windowsのパスには最大260文字という制限（MAX_PATH）が存在します。UNCパスや長いファイル名を使用する場合、この制限に抵触しないよう注意が必要です。Win32 APIの多くはUNCパス \\?\ プレフィックスをサポートしていますが、VBAの Dir 関数などはこのプレフィックスに対応していません。

まとめ

Excel VBAとWin32 APIを組み合わせることで、従来のVBAのファイル操作機能の限界を克服し、大幅な高速化と高度な機能性を実現できます。CopyFileEx や MoveFileEx などのAPIを直接利用することで、ファイルコピーや移動処理のパフォーマンスを劇的に向上させることが可能であることが示されました。

また、Application.ScreenUpdating = False、Application.Calculation = xlCalculationManual などのVBA共通の最適化テクニックを併用することで、処理全体の効率をさらに高めることができます。これらの手法を適切に適用することで、大規模なファイル操作を含む業務自動化スクリプトの堅牢性と実行速度を向上させ、ユーザーエクスペリエンスを改善することが可能です。 Win32 APIの利用には正確な宣言と慎重なエラーハンドリングが求められますが、その効果は実務において非常に強力な武器となります。

ライセンス：本記事のテキスト/コードは特記なき限り CC BY 4.0 です。引用の際は出典URL（本ページ）を明記してください。
利用ポリシー もご参照ください。

コメント

タイトルとURLをコピーしました