VBA Win32APIでフォルダ作成

Office自動化

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

VBA Win32APIでフォルダ作成

VBAを使用してOfficeアプリケーションからフォルダを自動作成する際、Win32 APIを活用することで、MkDirよりも高度な制御とパフォーマンス向上が可能です。本稿ではその具体的な実装と最適化について解説します。

背景/要件

VBA標準のMkDirステートメントは、既存の親ディレクトリ内に単一の新しいディレクトリを作成する場合にのみ機能します。パスの途中に存在しないディレクトリが含まれる場合はエラーが発生します。実務では、アプリケーションのデータ出力先やログ保存先として、複数階層にわたるフォルダを動的に作成する必要が生じます。この要件を満たすためには、Windows APIのCreateDirectoryやSHCreateDirectoryExを利用することが効果的です。特に、SHCreateDirectoryExはMkDirでは不可能な多階層のディレクトリを一括で作成する機能を提供します。

設計

フォルダ作成機能は、以下のWin32 API関数を中心に設計します。

  • CreateDirectoryW: 指定されたパスにディレクトリを作成します。既に存在する場合は成功を返しますが、パスの途中に存在しないディレクトリがある場合は失敗します。
  • SHCreateDirectoryExW: 指定されたパスに多階層のディレクトリを作成します。親ディレクトリが存在しない場合でも、それらも自動的に作成します。
  • GetLastError: API呼び出しが失敗した場合に、その原因を示すエラーコードを取得します。

これらのAPIを使用することで、VBAのMkDirでは困難な以下の要件に対応します。

  1. 多階層ディレクトリの作成: SHCreateDirectoryExWにより、一括で多階層のフォルダを作成できます。
  2. 詳細なエラーハンドリング: GetLastErrorを利用し、API呼び出し失敗時に具体的なエラー原因を特定します。
  3. 既存フォルダのチェック: API呼び出し前にDir関数などで存在チェックを行うことで、不必要な処理を回避します。
  4. 64bit環境への対応: Declare PtrSafeキーワードを使用して、32bit/64bit Office環境の両方で安全にAPIを呼び出せるようにします。

処理フロー

フォルダ作成処理の基本的な流れを以下のフローチャートで示します。

graph TD
    A["処理開始"] --> B{"フォルダパス取得"};
    B --> C{"パスの存在確認"};
    C --|パスが存在する| D["処理終了 | 作成不要"];
    C --|パスが存在しない| E{"多階層作成の必要性"};
    E --|必要なし (単一階層)| F["CreateDirectoryW API呼び出し"];
    E --|必要あり (多階層)| G["SHCreateDirectoryExW API呼び出し"];
    F --> H{"API呼び出し結果判定"};
    G --> H;
    H --|成功| I["フォルダ作成成功"];
    H --|失敗| J["GetLastErrorでエラー取得 | エラーログ記録"];
    I --> K["処理終了"];
    J --> K;

実装

以下のコード例は、ExcelとAccessの両方で利用可能です。標準モジュールに記述して使用します。

コード1: 基本的なフォルダ作成関数 (Excel/Access共通)

このコードは、指定されたパスにフォルダを作成する関数です。SHCreateDirectoryExWを使用することで、多階層のフォルダも効率的に作成できます。

Option Explicit

' Win32 API関数の宣言
' フォルダ作成 (多階層対応)
Private Declare PtrSafe Function SHCreateDirectoryExW Lib "shell32.dll" ( _
    ByVal hwnd As LongPtr, _
    ByVal pszPath As LongPtr, _
    ByVal psa As LongPtr _
) As Long

' Win32 API関数の宣言
' 直近のエラーコードを取得
Private Declare PtrSafe Function GetLastError Lib "kernel32" () As Long

' UTF-16文字列からポインタを生成するヘルパー関数
#If VBA7 Then
Private Function StrPtrW(ByVal str As String) As LongPtr
    StrPtrW = VBA.StrPtr(str)
End Function
#Else
Private Function StrPtrW(ByVal str As String) As Long
    StrPtrW = VBA.StrPtr(str)
End Function
#End If

'--------------------------------------------------------------------------------------------------
' 機能: 指定されたパスにフォルダを作成します。
'       多階層のパスにも対応しており、親フォルダが存在しない場合も作成します。
' 引数:
'   sPath: 作成するフォルダのフルパス (例: "C:\Temp\NewFolder\SubFolder")
' 戻り値:
'   True: フォルダが正常に作成されたか、既に存在していた場合
'   False: フォルダ作成に失敗した場合
'--------------------------------------------------------------------------------------------------
Public Function CreateFolderAPI(ByVal sPath As String) As Boolean
    Dim lResult As Long
    Dim lLastError As Long
    Dim sMsg As String

    CreateFolderAPI = False ' 初期値を失敗とする

    ' フォルダが既に存在するかチェック
    ' Dir関数はフォルダが存在すればフォルダ名を返す
    If Len(Dir(sPath, vbDirectory)) > 0 Then
        Debug.Print "Info: フォルダ '" & sPath & "' は既に存在します。"
        CreateFolderAPI = True
        Exit Function
    End If

    ' SHCreateDirectoryExW を呼び出してフォルダを作成
    ' psa (セキュリティ属性) は通常 0 (NULL) を指定
    lResult = SHCreateDirectoryExW(0, StrPtrW(sPath), 0)

    ' 結果をチェック
    ' 0 (ERROR_SUCCESS) は成功を意味する
    If lResult = 0 Then
        Debug.Print "Success: フォルダ '" & sPath & "' が正常に作成されました。"
        CreateFolderAPI = True
    Else
        lLastError = GetLastError() ' API呼び出し失敗時のエラーコードを取得

        Select Case lLastError
            Case 3 ' ERROR_PATH_NOT_FOUND (パスが見つかりません) - SHCreateDirectoryExWでは通常発生しないが念のため
                sMsg = "指定されたパスが見つかりません。"
            Case 5 ' ERROR_ACCESS_DENIED (アクセスが拒否されました)
                sMsg = "アクセス権限がありません。"
            Case 123 ' ERROR_INVALID_NAME (ファイル名、ディレクトリ名、またはボリュームラベルの構文が正しくありません)
                sMsg = "パスに無効な文字が含まれています。"
            Case 183 ' ERROR_ALREADY_EXISTS (ファイルが既に存在します)
                ' Dir関数でチェックしているため、ここに来ることは稀だが念のため
                sMsg = "フォルダは既に存在します。"
                CreateFolderAPI = True ' 既に存在する場合は成功とみなす
            Case Else
                sMsg = "不明なエラーが発生しました。エラーコード: " & lLastError
        End Select

        Debug.Print "Error: フォルダ '" & sPath & "' の作成に失敗しました。 " & sMsg
    End If
End Function

'--------------------------------------------------------------------------------------------------
' テスト用サブプロシージャ (Excel/Access共通)
'--------------------------------------------------------------------------------------------------
Public Sub TestFolderCreation()
    Dim sBaseFolder As String
    Dim sTargetFolder As String
    Dim bResult As Boolean
    Dim dtStart As Double, dtEnd As Double
    Dim lCount As Long
    Dim arrPaths() As String

    ' 性能チューニングの設定 (Excelの場合のみ有効)
    #If AppWin32 Then ' Excelアプリケーションか確認
        If TypeOf Application Is Excel.Application Then
            With Application
                .ScreenUpdating = False
                .Calculation = xlCalculationManual
                .EnableEvents = False
            End With
        End If
    #End If

    sBaseFolder = Environ("USERPROFILE") & "\Desktop\TestFolderAPI\" ' デスクトップに作成

    ' --- ケース1: 単一階層のフォルダ作成 ---
    Debug.Print vbCrLf & "--- ケース1: 単一階層 ---"
    sTargetFolder = sBaseFolder & "MyNewFolder"
    bResult = CreateFolderAPI(sTargetFolder)
    If bResult Then
        Debug.Print "テスト1成功: " & sTargetFolder
    Else
        Debug.Print "テスト1失敗: " & sTargetFolder
    End If

    ' --- ケース2: 多階層のフォルダ作成 ---
    Debug.Print vbCrLf & "--- ケース2: 多階層 ---"
    sTargetFolder = sBaseFolder & "Parent\Child\Grandchild"
    bResult = CreateFolderAPI(sTargetFolder)
    If bResult Then
        Debug.Print "テスト2成功: " & sTargetFolder
    Else
        Debug.Print "テスト2失敗: " & sTargetFolder
    End If

    ' --- ケース3: 既に存在するフォルダの作成 (成功として処理されることを確認) ---
    Debug.Print vbCrLf & "--- ケース3: 既存フォルダ ---"
    sTargetFolder = sBaseFolder & "Parent" ' 上記で作成済み
    bResult = CreateFolderAPI(sTargetFolder)
    If bResult Then
        Debug.Print "テスト3成功 (既存): " & sTargetFolder
    Else
        Debug.Print "テスト3失敗 (既存): " & sTargetFolder
    End If

    ' --- ケース4: 無効な文字を含むパス (失敗することを確認) ---
    Debug.Print vbCrLf & "--- ケース4: 無効パス ---"
    sTargetFolder = sBaseFolder & "Invalid:<Name>"
    bResult = CreateFolderAPI(sTargetFolder)
    If Not bResult Then
        Debug.Print "テスト4成功 (無効パス失敗): " & sTargetFolder
    Else
        Debug.Print "テスト4失敗 (無効パス成功): " & sTargetFolder ' 予期せぬ成功
    End If

    ' --- ケース5: 大量のフォルダ作成 (性能評価) ---
    Debug.Print vbCrLf & "--- ケース5: 複数フォルダの連続作成 (性能評価) ---"
    Const NUM_FOLDERS As Long = 500 ' 作成するフォルダ数
    ReDim arrPaths(1 To NUM_FOLDERS)
    For lCount = 1 To NUM_FOLDERS
        arrPaths(lCount) = sBaseFolder & "BulkTest\Folder_" & Format(lCount, "0000")
    Next lCount

    dtStart = Timer
    For lCount = 1 To NUM_FOLDERS
        ' Debug.Print "Creating: " & arrPaths(lCount) ' デバッグ出力はパフォーマンスに影響するためコメントアウト
        bResult = CreateFolderAPI(arrPaths(lCount))
        If Not bResult Then
            Debug.Print "連続作成中に失敗: " & arrPaths(lCount)
            ' Exit For ' 失敗しても続行するかどうかは要件による
        End If
    Next lCount
    dtEnd = Timer
    Debug.Print "Info: " & NUM_FOLDERS & "個のフォルダ作成に " & Format(dtEnd - dtStart, "#,##0.00") & " 秒かかりました。"

    ' 性能チューニングを元に戻す (Excelの場合のみ有効)
    #If AppWin32 Then
        If TypeOf Application Is Excel.Application Then
            With Application
                .ScreenUpdating = True
                .Calculation = xlCalculationAutomatic
                .EnableEvents = True
            End With
        End If
    #End If

    Debug.Print vbCrLf & "--- 全テスト完了 ---"
End Sub

性能チューニング

VBAからWin32 APIを呼び出す際の性能チューニングは、API呼び出しそのものよりも、VBAの実行環境と連携する部分に焦点を当てます。

  • Excelの場合:

    • Application.ScreenUpdating = False: 画面更新を停止することで、VBA実行中の描画処理によるオーバーヘッドを大幅に削減します。例えば、TestFolderCreationサブプロシージャで500個のフォルダを作成する際、ScreenUpdating = Falseに設定することで、約0.5秒の処理が0.05秒に短縮される可能性があります（純粋なAPI呼び出し時間が短いため、VBAループやDebug.Printの影響が大きい）。
    • Application.Calculation = xlCalculationManual: 計算モードを手動に設定することで、シート上の数式がVBAの操作ごとに再計算されるのを防ぎます。フォルダ作成自体は直接計算に影響しませんが、その後にファイル出力や結果をシートに書き込むなどの処理が続く場合に有効で、全体の処理時間を最大で数倍短縮できることがあります。
    • Application.EnableEvents = False: イベントの発生を抑制します。これは、イベントプロシージャが頻繁にトリガーされるのを防ぎ、処理速度を向上させます。 これらの設定は、VBAコードの実行前に設定し、処理完了後に元の状態に戻すことが大切です。

  • 配列バッファ: フォルダパスを事前に配列に格納し、ループ内で配列からパスを読み込むことで、都度文字列操作を行うよりも効率的です。上記のTestFolderCreationのケース5でarrPathsを使用しているのがその例です。

検証

作成したCreateFolderAPI関数は、以下のケースで検証を行います。

  1. 正常系:
    • 存在しない単一階層のフォルダパス
    • 存在しない多階層のフォルダパス
    • 既に存在するフォルダパス（成功とみなされることを確認）
  2. 異常系:
    • 無効な文字を含むフォルダパス（例: C:\Test:<Invalid>Folder）
    • アクセス権限がない場所へのフォルダパス（例: C:\Windows\System32\NewFolder）
    • パスが最大長（MAX_PATH=260文字、Windows 10では設定により4096文字）を超えるパス

TestFolderCreationサブプロシージャを実行し、イミディエイトウィンドウに出力されるメッセージを確認することで、各ケースの動作を検証できます。特に、異常系ではGetLastErrorが返すエラーコードとDebug.Printで出力されるメッセージが正しいことを確認します。

運用

本機能を実務で運用する際には、以下の点に留意してください。

  • エラーログの記録: Debug.Print出力だけでなく、ファイルやシート、データベースにエラー情報を記録する仕組みを導入することで、運用中の問題を追跡しやすくなります。
  • 権限管理: フォルダ作成はファイルシステムへの書き込み操作であるため、実行ユーザーの適切なアクセス権限が必要です。権限不足によるエラーが発生しないよう、事前に確認してください。
  • パスの動的な生成: 年月日、顧客名、プロジェクト名など、変動する情報に基づいてフォルダパスを動的に生成する際は、パスに含まれる特殊文字（/, \, :, *, ?, ", <, >, |）を適切に処理または置換するロジックを追加してください。
  • 64bit環境対応: PtrSafeキーワードを使用しているため、32bit版と64bit版のOfficeアプリケーション両方で動作します。

落とし穴

Win32 APIを利用する際には、いくつかの注意点があります。

  • パスの最大長: Windowsのファイルパスには、通常MAX_PATH（260文字）という制限があります。これを超えるパスは、SHCreateDirectoryExWを使用しても作成できない場合があります。Windows 10以降ではレジストリ設定によりこの制限を緩和できますが、すべての環境で有効とは限りません。
  • ユニコードパス (Wサフィックス): SHCreateDirectoryExWのように関数名の末尾にWが付くAPIは、ユニコード（UTF-16）文字列を引数に取ります。VBAの文字列は内部的にユニコードであるため、StrPtrW関数でポインタを渡すことで正しく処理されます。
  • アクセス権限: フォルダを作成するターゲットディレクトリに対する書き込み権限がない場合、API呼び出しはERROR_ACCESS_DENIED (エラーコード5) で失敗します。
  • GetLastErrorの使用: GetLastError関数は、API呼び出しが失敗した直後に呼び出す必要があります。他のVBAコードが実行されると、GetLastErrorが返す値が変わってしまう可能性があります。
  • DLLのバージョン: shell32.dllはWindowsの標準DLLですが、古いWindowsバージョンではSHCreateDirectoryExW関数が存在しない場合があります。現代のWindows環境ではほとんど問題になりませんが、レガシーシステムで運用する場合は注意が必要です。

まとめ

VBAの標準機能では実現が難しい多階層フォルダの作成や、堅牢なエラーハンドリングが必要な場合、Win32 APIのSHCreateDirectoryExW関数は非常に強力な選択肢となります。Declare PtrSafeによる32bit/64bit対応、GetLastErrorによる詳細なエラー特定、そしてExcel固有の性能チューニングを組み合わせることで、Officeアプリケーションにおけるファイルシステム操作の自動化をより効率的かつ安定的に実現できます。

実行手順とロールバック方法

実行手順

  1. VBAエディタの起動: ExcelまたはAccessを開き、Alt + F11キーを押してVBAエディタ（Microsoft Visual Basic for Applications）を起動します。
  2. モジュールの挿入: プロジェクトエクスプローラー（通常は左側）で、対象のVBAプロジェクト（例: VBAProject (ファイル名.xlsm)またはデータベース名 (Access)）を右クリックし、「挿入」→「標準モジュール」を選択します。
  3. コードの貼り付け: 新しく作成されたモジュールウィンドウに、上記「実装」セクションのVBAコードを全てコピーして貼り付けます。
  4. プロシージャの実行: VBAエディタでTestFolderCreationサブプロシージャ内にカーソルを置き、F5キーを押すか、ツールバーの「実行」ボタンをクリックします。
  5. 結果の確認: VBAエディタの下部にある「イミディエイトウィンドウ」（表示されていない場合は「表示」メニューから選択）に、フォルダ作成の結果メッセージが表示されます。デスクトップにTestFolderAPIというフォルダが作成され、その中にサブフォルダが生成されていることを確認します。

ロールバック方法

  1. 作成されたフォルダの削除: 上記の実行手順で作成されたC:\Users\<ユーザー名>\Desktop\TestFolderAPIフォルダを、エクスプローラーから手動で削除します。
  2. VBAモジュールの削除: VBAエディタに戻り、手順2で挿入したモジュール（通常はModule1などの名前）を右クリックし、「<モジュール名> の削除」を選択します。削除の確認メッセージが表示されたら、「いいえ」を選択してエクスポートしないようにします。
  3. ファイルの上書き保存: Excel/Accessファイルを上書き保存し、変更を確定します。もし元の状態に戻す必要がある場合は、事前に取得したバックアップファイルから復元します。
ライセンス：本記事のテキスト/コードは特記なき限り CC BY 4.0 です。引用の際は出典URL（本ページ）を明記してください。
利用ポリシー もご参照ください。

コメント

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