Win32 APIを用いた高速かつ安定したフォルダ選択ダイアログの実装

Tech

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

Win32 APIを用いた高速かつ安定したフォルダ選択ダイアログの実装

【背景と目的】 標準のFileDialogが動作不安定な環境や、特定のシステム要件で外部ライブラリを制限される場面でも、高速かつ確実にフォルダパスを取得する手段を確立します。

【処理フロー図】

graph TD
A["ユーザー処理開始"] --> B{"Win32 API定義"}
B --> C["BROWSEINFO構造体の設定"]
C --> D["SHBrowseForFolderの呼び出し"]
D --> E{"PIDL取得成功?"}
E -- YES --> F["SHGetPathFromIDListでパス変換"]
F --> G["CoTaskMemFreeでメモリ解放"]
E -- NO --> H["処理中断・戻り値クリア"]
G --> I["パスを呼び出し元に返却"]
H --> I

【実装:VBAコード】

Option Explicit

' --- Win32 API 宣言 (64bit/32bit両対応) ---
#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
    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 BIF_NEWDIALOGSTYLE = &H40      ' 新しいスタイル(サイズ変更可)
Private Const MAX_PATH = 260

''' <summary>
''' 高性能フォルダ選択ダイアログを表示し、選択されたパスを返します。
''' </summary>
''' <param name="title">ダイアログに表示する説明文</param>
''' <returns>選択されたフォルダのフルパス(キャンセル時は空文字)</returns>
Public Function GetFolderPath(Optional ByVal title As String = "フォルダを選択してください") As String
    Dim ubi As BROWSEINFO
    Dim pidl As LongPtr
    Dim retPath As String

    ' 高速化設定:描画更新の停止
    Application.ScreenUpdating = False

    On Error GoTo ErrorHandler

    ' 構造体の初期化
    With ubi
        .hOwner = Application.hWnd
        .lpszTitle = title
        .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE
    End With

    ' ダイアログの表示
    pidl = SHBrowseForFolder(ubi)

    ' パスの取得処理
    if pidl <> 0 Then
        retPath = String(MAX_PATH, vbNullChar)
        If SHGetPathFromIDList(pidl, retPath) Then
            ' ヌル文字を除去して取得
            GetFolderPath = Left(retPath, InStr(retPath, vbNullChar) - 1)
        End If
        ' メモリ解放(必須)
        Call CoTaskMemFree(pidl)
    Else
        GetFolderPath = ""
    End If

CleanUp:
    Application.ScreenUpdating = True
    Exit Function

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
    GetFolderPath = ""
    Resume CleanUp
End Function

''' <summary>
''' 実装テスト用プロシージャ
''' </summary>
Sub Test_GetFolderPath()
    Dim selectedPath As String
    selectedPath = GetFolderPath("実務用データ保存先を選択してください")

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

【技術解説】

  1. Win32 APIの採用: Application.FileDialog はOfficeのバージョンや参照設定に依存しますが、shell32.dll を直接呼び出すことで、OSレベルでの安定した動作を保証します。

  2. PtrSafe と LongPtr: 64bit版Officeでの動作に必須となる PtrSafe 属性と、メモリアドレスを適切に扱うための LongPtr 型を採用し、メモリ保護違反(アクセスバイオレーション)を防止しています。

  3. メモリ管理: SHBrowseForFolder で生成された PIDL(アイテムIDリストへのポインタ)は、Windowsのシステムメモリを消費します。CoTaskMemFree を確実に呼び出すことで、メモリリークを防止しています。

【注意点と運用】

  • メモリ解放の徹底: CoTaskMemFree を忘れると、Excelを閉じるまでメモリが占有され続け、動作が不安定になる原因となります。

  • パスの最大長: MAX_PATH(260文字)を超える深い階層のパスを取得する場合、APIの挙動が不安定になる可能性があるため、運用ルールで階層を深くしすぎない等の配慮が必要です。

  • 初期フォルダの指定: 本コードは標準実装ですが、特定のフォルダを初期表示させるにはコールバック関数の実装が必要になり、コードが複雑化するため、まずは汎用的な本構成を推奨します。

【まとめ】

  • 環境不問の安定性: Win32 API直叩きにより、Officeバージョンに左右されないツールを実現可能。

  • リソース管理: PIDLの取得後は必ずメモリ解放を行い、システム負荷を最小限に抑える。

  • 型定義の厳守: 64bit/32bitの条件分岐を正しく記述し、将来的な環境移行にも対応させる。

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

コメント

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