Win32 APIを利用した、高速で堅牢なフォルダ選択ダイアログの実装

Tech

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

Win32 APIを利用した、高速で堅牢なフォルダ選択ダイアログの実装

【背景と目的】

標準のFileDialogが動作不安定な環境や、OSネイティブの軽量な挙動を求める場合に、Win32 APIを用いて確実かつ高速にフォルダパスを取得します。

【処理フロー図】

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

【実装：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>
''' Win32 APIを使用してフォルダ選択ダイアログを表示し、選択されたパスを返します。
''' </summary>
Public Function GetFolderPathAPI(Optional ByVal strTitle As String = "フォルダを選択してください") As String
    Dim ubi As BROWSEINFO
    Dim lngPidl As LongPtr
    Dim strPath As String
    Dim lngResult As Long

    ' 画面更新停止（高速化・チラつき防止）
    Application.ScreenUpdating = False

    ' BROWSEINFO構造体の設定
    With ubi
        .hOwner = Application.hWnd          ' Excel/Accessのハンドルを指定
        .lpszTitle = strTitle               ' ダイアログに表示する説明文
        .ulFlags = BIF_RETURNONLYFSDIRS    ' ファイルは表示せずフォルダのみ
    End With

    ' ダイアログを表示し、PIDL（識別子）を取得
    lngPidl = SHBrowseForFolder(ubi)

    If lngPidl <> 0 Then
        ' PIDLから実際のパス文字列に変換
        strPath = String(MAX_PATH, 0)
        lngResult = SHGetPathFromIDList(lngPidl, strPath)

        If lngResult <> 0 Then
            ' 取得したパスからNull文字を除去
            GetFolderPathAPI = Left(strPath, InStr(strPath, vbNullChar) - 1)
        End If

        ' COMメモリの解放（メモリリーク防止の重要処理）
        Call CoTaskMemFree(lngPidl)
    Else
        ' キャンセル時
        GetFolderPathAPI = ""
    End If

    Application.ScreenUpdating = True
End Function

''' <summary>
''' 実行用プロシージャ
''' </summary>
Sub ExecuteFolderSelection()
    Dim selectedPath As String
    selectedPath = GetFolderPathAPI("実務用：バックアップ先を選択")

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

【技術解説】

  1. PtrSafe と LongPtr: 64bit版Officeでの動作を保証するため、ポインタを扱う型には LongPtr を使用し、宣言に PtrSafe を付与しています。

  2. SHBrowseForFolder: Shell32ライブラリに含まれる関数で、OS標準のフォルダブラウザを呼び出します。Application.FileDialog よりも低レイヤーで動作するため、参照設定の破損に強く、動作が軽量です。

  3. メモリ管理: API経由で取得した pidl（ポインタ）は、OSが確保したメモリ領域を指しています。これを放置するとメモリリークの原因となるため、CoTaskMemFree で明示的に解放することがプロフェッショナルな実装の要です。

【注意点と運用】

  • パスの最大長: Windowsの制限により、通常 MAX_PATH (260文字) を超えるパスは正しく取得できない場合があります。

  • 非同期処理の不在: ダイアログ表示中はVBAの実行が一時停止（モーダル状態）します。

  • 文字化け対策: 本コードは Alias "SHBrowseForFolderA" (ANSI版) を使用していますが、特殊文字を含むパスを扱う場合は W 版（Unicode）への書き換えを検討してください。

【まとめ】

  • 安定性: 外部ライブラリに依存せず、Windows標準機能のみで完結するため環境差異に強い。

  • 作法: PtrSafe と CoTaskMemFree をセットで使い、現代的なVBA開発基準を満たす。

  • 実務: ファイルパスの取得ミスを防ぐため、戻り値が空文字（キャンセル時）の判定を必ず行う。

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

コメント

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