内容
Windowsが標準で持っているフォルダ選択のダイアログを表示し、ユーザが選択したフォルダのパスを取得する方法です。
解説
フォルダ選択のダイアログはWindows APIのSHBrowseForFolder( )を使って表示します。
サンプルは、フォーム上のボタンがクリックされたときに呼ばれることを想定しており、関数SelectFolder_FS( )の中でSHBrowseForFolder( )の引数の値を設定しSHBrowseForFolder(
)をコールしてフォルダのパスを取得しています。フォルダ選択のダイアログを表示する際、SelectFolder_FS(
)の２番目の引数で指定された文字列をフォルダ選択のダイアログ上に表示します。
サンプル
Option Compare Database
'Windows API用の定数の宣言
'---フォルダ選択用
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
'ユーザ定義型の宣言
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
'Windows API関数の宣言
Private Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal _
lpString2 As String) As Long
Public Function SelectFolder_FS(MyForm As Form, szTitle As String) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim tBrowseInfo As BrowseInfo
On Error GoTo HandleErr
'szTitle = "フォルダを選択してください。"
With tBrowseInfo
.hWndOwner = MyForm.Hwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
SelectFolder_FS = sBuffer
End If
ExitHere:
Exit Function
HandleErr:
Select Case Err.Number
Case Else
MsgBox "エラー " & Err.Number & ": " & Err.Description, vbCritical, "ConvMain.SelectFolder_FS" 'ErrorHandler:$$N=ComUtil.SelectFolder_FS
End Select
' エラー処理ブロックを終了します。
SelectFolder_FS = ""
Resume ExitHere:
End Function