データのあるフォルダ(ディレクトリ)をダイアログで選択する方法を紹介します。
Visual Basic 6(SP3) + Windows95/98 + Internet Explorer 5で動作確認をしています。
[ 戻る ]
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
[ 戻る ]
スタートメニュー内の「ファイルやフォルダ」の検索で使われている「フォルダ一覧」のダイアログを呼び出します。ここで使用するAPIを以下に示します。
機能 | 「フォルダの参照」ダイアログを開き、選択されたフォルダのID値を取得します。 | |
---|---|---|
宣言 |
|
|
引数 | lpBROWSEINFO | BROWSEINFO構造体のアドレス |
戻り値 | 選択されたフォルダのID値 |
機能 | SHBrowseForFolder APIで得られたID値をパス名に変換します。 | |
---|---|---|
宣言 |
|
|
引数 | pidl | ID値 |
pszPath | 変換されたパス名 |
機能 | タスクのメモリブロックを解放します。 | |
---|---|---|
宣言 |
|
|
引数 | pv | 解放するブロックへのポインタ |
使用する構造体と定数を次に示します。
宣言 |
|
|
---|---|---|
メンバ | hwndOwner | 親Windowのハンドル |
pidlRoot | 表示上のルートフォルダの位置。以下の定数で設定します。
|
|
pszDisplayName | 選択されたフォルダ名 | |
lpszTitle | ダイアログに表示する文字列 | |
ulFlags | ダイアログのオプションフラグ。2つ以上設定するときはOr演算子で結びます。
|
|
lpfn | コールバック関数のアドレス | |
lParam | コールバック関数へ渡すパラメータ | |
iImage |
宣言 |
|
---|---|
説明 | パス名の最大バイト数 |
ソースを示します。
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
[ 戻る ]
本項の内容はVisual Basic 5以降で利用できます。上に示したソースでは、初期フォルダがBROWSEINFO構造体のpidlRootで指定されたフォルダになってしまいます。任意のフォルダを初期フォルダに指定するときは、コールバック関数を使います。コールバック関数の書式を次に示します。関数名は任意の名前にできますが、標準モジュールに作成する必要があります。
宣言 |
|
|
---|---|---|
引数 | hWnd | BrowseダイアログのWindowハンドル |
uMsg | Browseダイアログが受信したメッセージ
|
|
lParam | Browseダイアログからのパラメータ値。uMsgを参照 | |
lpData | BROWSEINFO構造体のlParamメンバに設定された値 |
コールバック関数内でSendMessage APIを使うことによりメッセージをWindowsに送信することができます。
意味 | ステータステキストの設定 |
---|---|
値 | BFFM_SETSTATUSTEXTA (WM_USER + 100) BFFM_SETSTATUSTEXTW (WM_USER + 104) |
wParam | 0 |
lParam | ステータステキストに表示する文字列 BROWSEINFO構造体のuFlagsメンバーにBIF_STATUSTEXTを設定 |
戻り値 | なし |
意味 | OKボタンの有効/無効の設定 |
---|---|
値 | WM_USER + 101 |
wParam | 0 |
lParam |
|
戻り値 | なし |
意味 | 初期フォルダの設定 Message送信後、BrowseダイアログはBFFM_SELECTIONCHANGEDを受信 |
---|---|
値 | BFFM_SETSELECTIONA (WM_USER + 102) BFFM_SETSELECTIONW (WM_USER + 103) |
wParam | 1 / 0 |
lParam |
|
戻り値 | なし |
意味 | ウィンドウクラスが使用するメッセージ番号の先頭の値 |
---|---|
値 | &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
[ 戻る ]