选择文件夹对话框 / 秋梦无痕

选择文件夹对话框

Visual Studio .NET 中新增了FolderBrowserDialog 组件，但是在VB6.0中还是只能用API来实现打开文件夹了：

以下代码来自http://www.vbaspnew.com/ziyuan/w/api/21.txt，略有改动。

Option Explicit
Private Type BROWSEINFO
hOwner As Long ' 当前窗口的句柄。
pidlRoot As Long ' 从何根路径开始展开文件夹，缺省情况下从“桌面”开始展开。
pszDisplayName As String
lpszTitle As String ' 目录树上方的标题，用来给用户一些提示信息。
ulFlags As Long ' 显示标志控制项：比如若赋值为BIF_BROWSEFORCOMPUTER，则只有当用户选择“我的电脑”时“确定”按钮才有效，这里我们需要的是 BIF_RETURNONLYFSDIRS，只有用户选择的是文件夹时“确定”按钮才有效。
lpfn As Long
lParam As Long
iImage As Long
End Type
Const BIF_RETURNONLYFSDIRS = &H1
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
' 此函数返回值是指向项目（ITEM）的一个指针，有了这个数值，再用API函数SHGetPathFromIDList可以获得具体的路径，如果用户按的是“取消”按钮，则返回值为NULL。
Private Sub Form_Load()
Dim bi As BROWSEINFO
Dim r As Long
Dim pidl As Long
Dim path As String
Dim pos As Integer
'句柄
bi.hOwner = Me.hWnd
'展开根目录
bi.pidlRoot = 0&
'列表框标题
bi.lpszTitle = "请选择路径："
'规定只能选择文件夹，其他无效
bi.ulFlags = BIF_RETURNONLYFSDIRS
'调用API函数显示列表框
pidl = SHBrowseForFolder(bi)
'利用API函数获取返回的路径
path = Space$(512)
r = SHGetPathFromIDList(ByVal pidl&, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
Me.Caption = Left(path, pos - 1)
Else: Me.Caption = "C:\"
End If
End Sub