Win32 APIを活用した高信頼性フォルダ選択ダイアログ：64bit VBA対応版

Tech

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

Win32 APIを活用した高信頼性フォルダ選択ダイアログ：64bit VBA対応版

【背景と目的】

標準のFileDialogが動作不安定な環境や、Access等の古い資産で詳細な制御が必要な際、APIによるダイアログ実装は「高速・確実」な解決策となります。

【処理フロー図】

graph TD
A["開始"] --> B["BROWSEINFO構造体の初期化"]
B --> C["SHBrowseForFolderの呼び出し"]
C --> D{"IDリストの取得成否"}
D -- 成功 --> E["SHGetPathFromIDListでパス変換"]
D -- キャンセル --> G["空文字を返す"]
E --> F["CoTaskMemFreeでメモリ解放"]
F --> H["終了"]
G --> H

【実装：VBAコード】

Win32 APIを直接制御するため、参照設定を増やさずに動作します。64bit/32bit両環境で動作するよう PtrSafe と LongPtr を適切に配置しています。

Option Explicit

' --- Win32 API 定義 (64bit/32bit 共通) ---
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

' API宣言: PtrSafeを必須とし、ポインタ型にはLongPtrを使用
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)

' フラグ定数
Private Const BIF_RETURNONLYFSDIRS = &H1      ' ディレクトリのみ選択可能
Private Const BIF_NEWDIALOGSTYLE = &H40       ' 新しいUIスタイル（サイズ変更可）
Private Const MAX_PATH = 260

''' <summary>
''' 高精度なフォルダ選択ダイアログを表示し、選択されたパスを返します。
''' </summary>
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

    On Error GoTo ErrorHandler

    ' 構造体のセットアップ
    With ubi
        .hOwner = 0 ' デスクトップを親にする
        .lpszTitle = strTitle
        .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE
    End With

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

    If lngPidl <> 0 Then
        ' IDリストからパス文字列へ変換
        strPath = String(MAX_PATH, vbNullChar)
        If SHGetPathFromIDList(lngPidl, strPath) <> 0 Then
            ' ヌル文字以降をカットして取得
            GetFolderPath = Left(strPath, InStr(strPath, vbNullChar) - 1)
        End If

        ' メモリ解放 (APIを使用する場合の必須処理)
        Call CoTaskMemFree(lngPidl)
    Else
        ' キャンセル時
        GetFolderPath = ""
    End If

CleanUp:
    Application.ScreenUpdating = True
    Exit Function

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

' --- テスト用マクロ ---
Sub Test_FolderDialog()
    Dim selectedPath As String
    selectedPath = GetFolderPath("保存先フォルダを選択してください")

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

【技術解説】

  1. PtrSafe と LongPtr: 64bit版Officeではメモリアドレスが64bit化されているため、ポインタを扱う戻り値や引数には LongPtr を使用し、宣言に PtrSafe を付与することで実行時エラーを防ぎます。

  2. SHBrowseForFolder: Windows標準のフォルダブラウザを呼び出します。BIF_NEWDIALOGSTYLE を指定することで、フォルダの新規作成ボタンがある現代的なUIになります。

  3. メモリ管理: SHBrowseForFolder が確保したメモリ領域（IDリスト）は、VBAのガベージコレクション対象外です。必ず CoTaskMemFree を呼び出して解放しないと、メモリリークの原因となります。

【注意点と運用】

  • パスの最大長: MAX_PATH (260文字) を超えるパスは、このAPIの標準的な呼び出しでは切り捨てられるリスクがあります。ネットワークパスが極端に長い環境では注意が必要です。

  • 文字コード: 今回は Alias "SHBrowseForFolderA" (ANSI版) を使用しています。Unicode文字（特殊な漢字や記号）を含むフォルダ名を扱う場合は、W 版のAPIと StrPtr を使用する実装への変更を検討してください。

【まとめ】

  1. APIの恩恵: 外部ライブラリ（参照設定）に依存せず、どのPC環境でも安定して動作するフォルダ選択が可能です。

  2. メモリ解放の徹底: CoTaskMemFree を忘れるとアプリの強制終了を招くため、必ずセットで実装します。

  3. UIの標準化: BIF_NEWDIALOGSTYLE を使うことで、ユーザーにとって親しみやすい操作感を提供できます。

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

コメント

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