Oka Laboratory

フォルダの選択

データのあるフォルダ(ディレクトリ)をダイアログで選択する方法を紹介します。

Visual Basic 6(SP3) + Windows95/98 + Internet Explorer 5で動作確認をしています。

Common Dialogコントロール

Common Dialogコントロールの「ファイルを開く」ダイアログを使った簡易版です。ユーザがファイルを選択し、そのフルパス名からディレクトリ文字列を切り出します。

'SplitPath関数で使う列挙型定数
Public Enum
SplitPathConstant
	spDriveNo = 1		'ドライブ名
	spPathName = 2		'パス
	spFileName = 4		'ファイル名
	spExtention = 8		'拡張子
End Enum

Public Function BrowseFolder$()
'データのあるフォルダの設定
	With CommonDialog1
		.DialogTitle = "データフォルダの指定"
		.FileName = App.ProductName			'ダミーのファイル名
		.Filter = "すべてのファイル|*.*"
		.Flags = cdlOFNHideReadOnly Or cdlOFNPathMustExist

		On Error Resume Next
		.ShowOpen					'「ファイルを開く」ダイアログを開く
		If Err.Number = 0 Then
			m$ = SplitPath(.FileName, 3)
			If Right$(m$, 1) = "\" And Len(m$) > 3 Then
				m$ = Left$(m$, Len(m$) - 1)	'ルートディレクトリ以外では末尾の\を削除
			End If
			BrowseFolder = m$
		End If
		On Error GoTo 0
	End With
End Function

Public Function SplitPath$(PathName$, flag As SplitPathConstant)
'パス名を分割
	If PathName = "" Then Exit Function

	Dim dot%, yen%, cor%, slen%

	slen = Len(PathName)
	dot = slen + 1
	For i% = slen To 1 Step -1
		Select Case Mid$(PathName, i%, 1)
			Case ".": If dot > slen Then dot = i%
			Case "\": If yen = 0 Then yen = i%
			Case ":": cor = i%
		End Select
	Next i%

	If yen = 0 Then yen = cor
	If flag And spDriveNo Then m$ = m$ & Left$(PathName, cor)
	If flag And spPathName Then m$ = m$ & Mid$(PathName, cor + 1, yen - cor)
	If flag And spFileName Then m$ = m$ & Mid$(PathName, yen + 1, dot - yen - 1)
	If flag And spExtention Then m$ = m$ & Mid$(PathName, dot)
	SplitPath = m$
End Function

SHBrowseForFolder API

スタートメニュー内の「ファイルやフォルダ」の検索で使われている「フォルダ一覧」のダイアログを呼び出します。ここで使用するAPIを以下に示します。

SHBrowseForFolder
機能 「フォルダの参照」ダイアログを開き、選択されたフォルダのID値を取得します。
宣言 Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBROWSEINFO As BROWSEINFO) As Long
引数 lpBROWSEINFO BROWSEINFO構造体のアドレス
戻り値 選択されたフォルダのID値
SHGetPathFromIDList
機能 SHBrowseForFolder APIで得られたID値をパス名に変換します。
宣言 Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
引数 pidl ID値
pszPath 変換されたパス名
CoTaskMemFree
機能 タスクのメモリブロックを解放します。
宣言 Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
引数 pv 解放するブロックへのポインタ

使用する構造体と定数を次に示します。

BROWSEINFO構造体
宣言
Public 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
メンバ hwndOwner 親Windowのハンドル
pidlRoot 表示上のルートフォルダの位置。以下の定数で設定します。
定数名 説明
CSIDL_DESKTOP &H0 デスクトップ
CSIDL_PROGRAMS &H2 スタートメニューの「プログラム」
CSIDL_CONTROLS &H3 コントロールパネル
CSIDL_PRINTERS &H4 プリンタ
CSIDL_PERSONAL &H5 パーソナル
CSIDL_FAVORITES &H6 「お気に入り」フォルダ
CSIDL_STARTUP &H7 「スタートアップ」フォルダ
CSIDL_RECENT &H8 スタートメニューの「最近使ったファイル」
CSIDL_SENDTO &H9 送る
CSIDL_BITBUCKET &HA ごみ箱
CSIDL_STARTMENU &HB スタートメニュー
CSIDL_DESKTOPDIRECTORY &H10 デスクトップ
CSIDL_DRIVES &H11 マイコンピュータ
CSIDL_NETWORK &H12 ネットワークコンピュータ
CSIDL_NETHOO &H13  
CSIDL_FONTS &H14 フォント
CSIDL_TEMPLATES &H15 Shell New
pszDisplayName 選択されたフォルダ名
lpszTitle ダイアログに表示する文字列
ulFlags ダイアログのオプションフラグ。2つ以上設定するときはOr演算子で結びます。
定数名 説明
BIF_RETURNONLYFSDIRS &H1 コントロールパネル、プリンタ、ブリーフケース内は選択不可
BIF_DONTGOBELOWDOMAIN &H2 ネットワークコンピュータ内のリソースを非表示
BIF_STATUSTEXT &H4 テキスト文字列を表示(設定はコールバック関数で行なう)
BIF_RETURNFSANCESTORS &H8 ネットワークコンピュータ内のリソースのみ選択可
BIF_EDITBOX &H10 フォルダ名を編集するテキストBoxを表示
BIF_VALIDATE &H20  
BIF_USENEWUI &H40 (Winodws2000のみ有効)
BIF_BROWSEFORCOMPUTER &H1000 ネットワークコンピュータ内のリソースのみ選択可
BIF_BROWSEFORPRINTER &H2000 ネットワークプリンタのみ選択可
BIF_BROWSEINCLUDEFILES &H4000 フォルダ内のファイル名も表示(Windows98以降)
lpfn コールバック関数のアドレス
lParam コールバック関数へ渡すパラメータ
iImage  
MAX_PATH定数
宣言 Public Const MAX_PATH = 260
説明 パス名の最大バイト数

ソースを示します。

Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBROWSEINFO As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Public 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
	
Public Const CSIDL_DESKTOP = &H0
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const MAX_PATH = 260

Public Function BrowseFolder$ ()
'データのあるフォルダの設定
	Dim Browse As BROWSEINFO
	Dim pID As Long
	Dim PathName As String
	
	With Browse
		.hwndOwner = Me.hWnd
		.pidlRoot = CSIDL_DESKTOP
		.lpszTitle = "フォルダを選択してください"
		.ulFlags = BIF_RETURNONLYFSDIRS
	End With

	'「フォルダの参照」ダイアログの呼び出し
	pID = SHBrowseForFolder(Browse)

	If pID Then
	'予めNull文字をセット
		PathName = String$(MAX_PATH, vbNullChar)

	'SHBrowseForFolderで得られた値からフォルダのパス名を取得
		SHGetPathFromIDList pID, PathName

	'割り当てられたメモリを開放
		CoTaskMemFree pID

		n% = InStr(PathName, vbNullChar)
		If n% Then
			BrowseFolder = Left$(PathName, n% - 1)
		End If
	End If
End Function

初期フォルダの指定(SHBrowseForFolder)

本項の内容はVisual Basic 5以降で利用できます。上に示したソースでは、初期フォルダがBROWSEINFO構造体のpidlRootで指定されたフォルダになってしまいます。任意のフォルダを初期フォルダに指定するときは、コールバック関数を使います。コールバック関数の書式を次に示します。関数名は任意の名前にできますが、標準モジュールに作成する必要があります。

SHBrowseForFolder
宣言 Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
引数 hWnd BrowseダイアログのWindowハンドル
uMsg Browseダイアログが受信したメッセージ
受信メッセージ 意味
BFFM_INITIALIZED 1 ダイアログの初期化終了、lParamはNULL
BFFM_SELECTIONCHANGE 2 選択が変更された。lParamは新しく選択されたフォルダのID
lParam Browseダイアログからのパラメータ値。uMsgを参照
lpData BROWSEINFO構造体のlParamメンバに設定された値

コールバック関数内でSendMessage APIを使うことによりメッセージをWindowsに送信することができます。

BFFM_SETSTATUSTEXTA / BFFM_SETSTATUSTEXTW
意味 ステータステキストの設定
WM_USER + 100(BFFM_SETSTATUSTEXTA) WM_USER + 104(BFFM_SETSTATUSTEXTW)
wParam 0
lParam ステータステキストに表示する文字列 BROWSEINFO構造体のuFlagsメンバーにBIF_STATUSTEXTを設定
戻り値 なし
BFFM_ENABLEOK
意味 OKボタンの有効/無効の設定
WM_USER + 101
wParam 0
lParam 0以外(有効) 0(無効)
戻り値 なし
BFFM_SETSELECTIONA / BFFM_SETSELECTIONW
意味 初期フォルダの設定 Message送信後、BrowseダイアログはBFFM_SELECTIONCHANGEDを受信
WM_USER + 102(BFFM_SETSELECTIONA) WM_USER + 103(BFFM_SETSELECTIONW)
wParam 1 / 0
lParam フォルダのID値(wParam = 0) フォルダのパス名文字列(wParam = 1)
戻り値 なし
WM_USER定数
意味 ウィンドウクラスが使用するメッセージ番号の先頭の値
&H400

メッセージのうち、末尾がAのものはShift-JIS(Winodws 9x系)、WのものはUnicode(Winodws NT系)の文字列を使います。またSendMessage APIのhWndには、コールバック関数に渡されるBrowseダイアログのWindowハンドルを指定します。

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const WM_USER = &H400
Public Const BFFM_SETSELECTIONA = (WM_USER + 102)
Public Const BFFM_INITIALIZED = 1

Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
'コールバック関数
	If uMsg = BFFM_INITIALIZED Then
		SendMessage hWnd, BFFM_SETSELECTIONA, 1, ByVal lpData
	End If
End Function

コールバック関数のアドレスはBROWSEINFO構造体のlpfnメンバーに設定します。しかしAddressOf演算子の値を変数に直接代入することができないので、次のFARPROC関数を標準モジュールに作成します。

Public Function FARPROC(pfn As Long) As Long
'AddressOf演算子の戻り値を戻す関数
	FARPROC = pfn
End Function

初期フォルダのパス名を指定するために、構造体のlParamメンバの型をString型に変更します。BROWSEINFO構造体への値の設定は以下のソースリストのようにします。ここではカレントフォルダが初期フォルダになります。

Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBROWSEINFO As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Public Type BROWSEINFO
	hwndOwner As Long
	pidlRoot As Long
	pszDisplayName As String
	lpszTitle As String
	ulFlags As Long
	lpfn As Long
	lParam As String	'String型に変更
	iImage As Long
End Type

Public Const CSIDL_DESKTOP = &H0
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const MAX_PATH = 260
Public Function BrowseFolder$ ()
'データのあるフォルダの設定
	Dim Browse As BROWSEINFO
	Dim pID As Long
	Dim PathName As String

	With Browse
		.hwndOwner = Me.hWnd
		.pidlRoot = CSIDL_DESKTOP
		.lpszTitle = "フォルダを選択してください"
		.ulFlags = BIF_RETURNONLYFSDIRS
		.lpfn = FARPROC(AddressOf BrowseCallbackProc)	'コールバック関数のアドレス
		.lParam = CurDir & vbNullChar			'初期フォルダのパス名
	End With

	'「フォルダの参照」ダイアログの呼び出し
	pID = SHBrowseForFolder(Browse)

	If pID Then
	'予めNull文字をセット
		PathName = String$(MAX_PATH, vbNullChar)

	'SHBrowseForFolderで得られた値からフォルダのパス名を取得
		SHGetPathFromIDList pID, PathName

	'割り当てられたメモリを開放
		CoTaskMemFree pID

		n% = InStr(PathName, vbNullChar)
		If n% Then
			BrowseFolder = Left$(PathName, n% - 1)
		End If
	End If
End Function

正当なCSSです!