【VBA】Win32 API（SHBrowseForFolder）による安定したフォルダ選択ダイアログの実装

Tech

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

【VBA】Win32 API（SHBrowseForFolder）による安定したフォルダ選択ダイアログの実装

【背景と目的】

標準のFileDialogでは困難な詳細制限や動作不具合を回避し、Win32 APIを用いて高速かつ環境に依存しないフォルダ選択UIを実現します。（67文字）

【処理フロー図】

graph TD
    A["処理開始"] --> B["BROWSEINFO構造体の初期化"]
    B --> C["SHBrowseForFolder API呼び出し"]
    C --> D{"フォルダが選択されたか?"}
    D -- Yes --> E["SHGetPathFromIDListでパス取得"]
    E --> F["CoTaskMemFreeでメモリ解放"]
    F --> G["取得パスを返却"]
    D -- No --> H["キャンセル処理"]
    H --> I["空文字を返却"]

※上記フローに従い、APIを用いたフォルダパスの取得とメモリ管理を正しく行います。

【実装：VBAコード】

Option Explicit

' ==========================================
' Win32 API 宣言 (32bit / 64bit 両対応)
' ==========================================
#If VBA7 Then

    ' 64bit環境用宣言
    Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPtr
    Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As LongPtr, ByVal pszPath As String) As Long
    Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As LongPtr)
#Else

    ' 32bit環境用宣言
    Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
    Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
#End If

' フォルダ選択ダイアログ用構造体
Private Type BROWSEINFO
    #If VBA7 Then

        hOwner As LongPtr
        pidlRoot As LongPtr
    #Else

        hOwner As Long
        pidlRoot As Long
    #End If

    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    #If VBA7 Then

        lpfn As LongPtr
        lParam As LongPtr
    #Else

        lpfn As Long
        lParam As Long
    #End If

    iImage As Long
End Type

' ダイアログのオプション定数
Private Const BIF_RETURNONLYFSDIRS As Long = &H1  ' 画面上でファイルシステム上のフォルダのみ選択可能にする

''' <summary>
''' Win32 APIを利用したフォルダ選択ダイアログを表示します。
''' </summary>
''' <returns>選択されたフォルダのフルパス（キャンセルの場合は空文字）</returns>
Public Function SelectFolderAPI() As String
    ' 画面描画の停止（高速化・チラつき防止）
    On Error GoTo ErrorHandler
    Application.ScreenUpdating = False

    Dim udtBI As BROWSEINFO
    #If VBA7 Then

        Dim pidl As LongPtr
    #Else

        Dim pidl As Long
    #End If

    Dim strPath As String * 260 ' MAX_PATHバッファの確保
    Dim lngResult As Long

    ' 構造体の初期設定
    With udtBI
        .hOwner = 0& ' 親ウィンドウハンドル（0はデスクトップ）
        .pidlRoot = 0& ' ルートフォルダ（0はデスクトップ配下）
        .lpszTitle = "対象のフォルダを選択してください。"
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    ' APIの呼び出し（ダイアログ表示）
    pidl = SHBrowseForFolder(udtBI)

    ' IDListからパス文字列への変換
    If pidl <> 0 Then
        lngResult = SHGetPathFromIDList(pidl, strPath)
        If lngResult <> 0 Then
            ' ヌル文字(Chr(0))を取り除いてパスを取得
            SelectFolderAPI = Left(strPath, InStr(strPath, vbNullChar) - 1)
        End If
        ' 使用したメモリの解放（必須）
        Call CoTaskMemFree(pidl)
    Else
        ' キャンセルが押された場合
        SelectFolderAPI = ""
    End If

CleanUp:
    Application.ScreenUpdating = True
    Exit Function

ErrorHandler:
    SelectFolderAPI = ""
    Resume CleanUp
End Function

''' <summary>
''' 動作確認用の実行サブルーチン
''' </summary>
Public Sub ExecFolderSelect()
    Dim selectedPath As String
    selectedPath = SelectFolderAPI()

    If selectedPath <> "" Then
        MsgBox "選択されたパス: " & selectedPath, vbInformation, "処理完了"
    Else
        MsgBox "フォルダ選択がキャンセルされました。", vbExclamation, "キャンセル"
    End If
End Sub

【技術解説】

  1. 64bit互換性の確保（PtrSafe / LongPtr）: VBA7（Excel 2010以降）に対応するため条件付きコンパイル（#If VBA7）を使用しています。ポインタを扱う変数やハンドル、API宣言には LongPtr と PtrSafe キーワードを指定することで、32bit/64bit双方のOffice環境で安全に動作します。

  2. メモリリークの防止（CoTaskMemFree）: SHBrowseForFolder が返却するポインタ（pidl）は、Windowsシステムによってメモリ割り当てが行われます。処理終了後に CoTaskMemFree を呼び出して解放しないと、繰り返し実行時にメモリリークの原因となります。

  3. 固定長文字列バッファ（String * 260）: Win32 APIでパスを受け取る際、Windowsの標準最大パス長（MAX_PATH = 260文字）に対応したメモリ領域をあらかじめ固定長文字列として確保しています。

【注意点と運用】

  • メモリ解放の徹底: pidl（ポインタ）を取得した後は、たとえパス変換処理が失敗した場合であっても必ず CoTaskMemFree で解放するロジックを通す必要があります。

  • Unicode（日本語文字化け）への考慮: 上記のサンプルはANSI版（SHBrowseForFolderA）を使用しています。特殊な外字やShift_JISに含まれないフォルダ名を取り扱う可能性がある場合は、Wide文字版（SHBrowseForFolderW）への置き換えとポインタ管理が必要です。

  • エラーハンドリング: Application.ScreenUpdating = False を指定した状態でVBAが強制終了すると画面更新が停止したままになるため、On Error GoTo による復元処理（CleanUp）を確実に通過させてください。

【まとめ】

  1. Win32 APIを使用する際は、PtrSafe と LongPtr を使用して64bit環境での動作を保証する。

  2. APIから割り当てられたメモリ（PIDL）は、処理後に必ず CoTaskMemFree で解放する。

  3. エラー処理や描画設定（ScreenUpdating）の復元ロジックを組み込み、安定運用を実現する。

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

コメント

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