【Excel/Access】Win32 APIによる堅牢なフォルダ選択ダイアログの実装

【背景と目的】

標準のFileDialogは環境により動作が不安定な場合があります。Win32 APIを直接制御し、OSネイティブな高速・軽量なフォルダ選択を実現します。

【処理フロー図】

graph TD
A["ユーザーが関数を呼び出し"] --> B["BROWSEINFO構造体の初期化"]
B --> C["SHBrowseForFolderの実行"]
C --> D{"フォルダ選択?"}
D -- Yes --> E["PIDLからパス文字列を取得"]
D -- No --> F["空文字を返却"]
E --> G["CoTaskMemFreeでメモリ解放"]
G --> H["完了"]
F --> 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              ' パスの最大長

''' 

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

    ' 画面更新停止によるチラつき防止
    Application.ScreenUpdating = False

    With ubi
        .hOwner = 0
        .lpszTitle = strTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    ' ダイアログを表示し、PIDL（アイテム識別子リストのポインタ）を取得
    lngPidl = SHBrowseForFolder(ubi)

    If lngPidl <> 0 Then
        ' PIDLから物理パスへ変換
        strPath = String(MAX_PATH, vbNullChar)
        If SHGetPathFromIDList(lngPidl, strPath) <> 0 Then
            ' ヌル文字以降を除去して抽出
            GetFolderPath = Left(strPath, InStr(strPath, vbNullChar) - 1)
        End If
        ' APIが確保したメモリを手動解放
        CoTaskMemFree lngPidl
    Else
        GetFolderPath = ""
    End If

    Application.ScreenUpdating = True
End Function

【技術解説】

1. PtrSafe と LongPtr: 64bit版Officeではメモリアドレスのサイズが異なるため、PtrSafe宣言とLongPtr型を使用し、ポインタを安全に扱っています。

2. PIDL (Pointer to Item Identifier List): Windowsシェルがファイルを識別する特殊なIDです。APIから返されるのはこのポインタであるため、SHGetPathFromIDListでパス文字列に変換する必要があります。

3. メモリ管理: API側で動的に確保されたメモリ（PIDL）は、VBA側でCoTaskMemFreeを呼び出さない限りメモリリークの原因となります。

【注意点と運用】

• メモリ解放の徹底: キャンセル時以外は必ず CoTaskMemFree を実行してください。ループ内で使用する場合、メモリ使用量が肥大化するリスクがあります。

• 参照設定不要: Win32 APIを直接叩くため、配布先のPCで「参照不可」エラーが発生するリスクが極めて低いです。

• UIの制約: SHBrowseForFolder は旧来のツリー型ダイアログです。最新のUIを求める場合は IFileOpenDialog (COM) の利用を検討してください。

【まとめ】

1. PtrSafe を使い、Officeのビット数を問わない共通コードを維持する。

2. メモリ管理 (CoTaskMemFree) を忘れず、システムリソースを保護する。

3. 汎用モジュールとして保存し、全プロジェクトで使い回せる標準部品にする。