Win32 APIを用いたVBAフォルダ選択：SHBrowseForFolderによる堅牢な実装

Tech

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

Win32 APIを用いたVBAフォルダ選択：SHBrowseForFolderによる堅牢な実装

【背景と目的】

標準のFileDialogが動作不安定な環境や、OS標準のシェル機能を用いた高度な制御が必要なケースにおいて、APIによる確実なフォルダ選択機能を実装します。

【処理フロー図】

graph TD
A["マクロ実行"] --> B["BROWSEINFO構造体の初期化"]
B --> C["SHBrowseForFolderの呼び出し"]
C --> D{"PIDL取得成功?"}
D -- Yes --> E["SHGetPathFromIDListでパス変換"]
E --> F["CoTaskMemFreeでメモリ解放"]
D -- No --> G["処理終了/キャンセル"]
F --> H["取得したパスを返却"]
G --> H

【実装：VBAコード】

Option Explicit

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

    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

    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
    hOwner As LongPtr
    pidlRoot As LongPtr
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As LongPtr
    lParam As LongPtr
    iImage As Long
End Type

' --- 定数 ---
Private Const BIF_RETURNONLYFSDIRS = &H1      ' ディレクトリのみ選択可能
Private Const MAX_PATH = 260                  ' パス最大長

''' <summary>
''' 高度なフォルダ選択ダイアログを表示し、選択されたパスを返します。
''' </summary>
Public Function GetFolderPathAPI(Optional ByVal strTitle As String = "フォルダを選択してください") As String
    Dim ubi As BROWSEINFO
    Dim lngPidl As LongPtr
    Dim strPath As String
    Dim ret As Long

    ' 高速化のため描画停止（API呼び出し時はマナーとして実施）
    Application.ScreenUpdating = False

    ' 構造体の初期化
    With ubi
        .hOwner = Application.hWnd            ' Excelのハンドルを指定
        .lpszTitle = strTitle                 ' ダイアログ上のメッセージ
        .ulFlags = BIF_RETURNONLYFSDIRS       ' フラグ設定
    End With

    ' ダイアログ表示（戻り値はPIDL：識別子へのポインタ）
    lngPidl = SHBrowseForFolder(ubi)

    If lngPidl <> 0 Then
        strPath = String(MAX_PATH, vbNullChar)
        ' PIDLから実際のファイルシステム上のパスを取得
        ret = SHGetPathFromIDList(lngPidl, strPath)

        If ret <> 0 Then
            ' ヌル文字以降を除去して結果を格納
            GetFolderPathAPI = Left(strPath, InStr(strPath, vbNullChar) - 1)
        End If

        ' 割り当てられたメモリ（PIDL）の解放（必須）
        Call CoTaskMemFree(lngPidl)
    Else
        ' キャンセル時
        GetFolderPathAPI = ""
    End If

    Application.ScreenUpdating = True
End Function

''' <summary>
''' 実行用テストコード
''' </summary>
Sub Test_GetFolder()
    Dim selectedPath As String
    selectedPath = GetFolderPathAPI("出力先フォルダを選択してください")

    If selectedPath <> "" Then
        MsgBox "選択されたパス: " & selectedPath, vbInformation
    Else
        MsgBox "キャンセルされました。", vbExclamation
    End If
End Sub

【技術解説】

  1. PIDL (Pointer to an Item Identifier List): Windows Shellがオブジェクトを識別するために使用する特殊な識別子です。SHBrowseForFolderはこのPIDLを返却するため、SHGetPathFromIDListを用いて文字列パスに変換する必要があります。

  2. メモリ管理 (CoTaskMemFree): PIDLはOS側でメモリが確保されます。VBA側でこれを解放しないと、繰り返し実行した際にメモリリークの原因となるため、ole32.dllのCoTaskMemFreeを必ず呼び出します。

  3. PtrSafe と LongPtr: Office 64bit版ではポインタが64bitになるため、LongPtr型を使用し、宣言にPtrSafeキーワードを付与することで互換性を確保しています。

【注意点と運用】

  • 参照設定不要: 本コードはWin32 APIを直接コールするため、参照設定のトラブルが発生しません。

  • マルチバイト文字: Alias "SHBrowseForFolderA" を使用しているため、Shift-JIS環境を想定しています。Unicode（UTF-16）を厳密に扱う場合は Alias "SHBrowseForFolderW" と、それに合わせた型変換が必要です。

  • hWndの指定: Application.hWnd を指定することで、ダイアログをExcelの親ウィンドウに対してモーダル（前面固定）に表示させ、操作ミスを防止します。

【まとめ】

  1. 安定性の向上: Office標準の FileDialog がライブラリの関係で動作しない環境でも確実に動作します。

  2. 適切なリソース管理: CoTaskMemFree によるメモリ解放を徹底し、業務システムでの長期稼働に耐える設計にします。

  3. 互換性の確保: PtrSafe と LongPtr を用いることで、32bit/64bit混在環境でもコードを書き換える必要がありません。

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

コメント

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