Const CSIDL_DESKTOP = &H0 ' デスクトップ
Const BIF_RETURNONLYFSDIRS = &H1
Const BIF_DONTGOBELOWDOMAIN = &H2
Const MAX_PATH = 260
Type BROWSEINFO
hwndOwner As Long ' 呼び出し元ウインドウハンドル
pidlRoot As Long ' 表示上のルートフォルダの位置
pszDisplayName As String ' 選択されたフォルダ名
lpszTitle As String ' ダイアログに表示する文字列
ulFlags As Long ' ダイアログのオプションフラグ
lpfn As Long ' コールバック関数のアドレス
lParam As Long ' コールバック関数へ渡すパラメータ
iImage As Long
End Type
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBROWSEINFO As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Dim w_ret As Long ' 戻り値
Dim w_tbrowseinfo As BrowseInfo ' フォルダダイアログ構造体
Dim w_buff As String * MAX_PATH ' パス名格納バッファ
' 呼び出し元ウインドウハンドルを設定
w_tbrowseinfo.hWndOwner = Form1.hwnd
' デスクトップをルートに指定
w_tbrowseinfo.pIDLRoot = CSIDL_DESKTOP
' ダイアログボックスの表示文字を設定
w_tbrowseinfo.lpszTitle = "フォルダを選択してください"
' ダイアログボックスのオプションを設定
w_tbrowseinfo.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
' ダイアログを表示する
w_ret = SHBrowseForFolder(w_tbrowseinfo)
' フォルダが選択された場合
If w_ret <> 0 Then
' パス名格納バッファを初期化
w_buff = String$(MAX_PATH, vbNullChar)
' 返却されたID値をパス名に変換する
w_ret = SHGetPathFromIDList(w_ret, w_buff)
End If
|