English Sentence Loading...
英语句子加载中...
使用VB调用API打开浏览文件夹对话框
作者:junyuqin 日期:2009-09-21
在VB中调用API的方式打开浏览文件夹对话框
新建一个工程,在窗体中放置一个Button,复制粘贴下面的代码:
程序代码
新建一个工程,在窗体中放置一个Button,复制粘贴下面的代码:

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Type BROWSEINFO
hOwner As Long '父窗口的句柄
pidlRoot As Long '指向希望浏览的最上层的文件夹的标识符列表,可设为0
pszDisplayName As String '返回你所选择的文件夹(带一个NULL字符)
lpszTitle As String '对话框标题(要以vbNullChar结尾)
ulFlags As Long '浏览标志(见下面)
lpfn As Long '回调函数的地址,可设为NULL
lParam As Long '若有回调函数,此项设置它的值
iImage As Long '保存所选文件夹映像索引的缓冲区
End Type
Private Const BIF_BROWSEFORCOMPUTER = &H1000 '允许浏览计算机
Private Const BIF_BROWSEFORPRINTER = &H2000 '允许浏览打印机文件夹
Private Const BIF_BROWSEINCLUDEFILES = &H4000 '允许同时浏览文件(需IE4)
Private Const BIF_DONTGOBELOWDOMAIN = &H2 '强制用户停留在网上邻居中
Private Const BIF_EDITBOX = &H10 '可在输入框中直接输入文件夹名(需IE4)
Private Const BIF_RETURNFSANCESTORS = &H8 '返回文件系统祖先?
Private Const BIF_RETURNONLYFSDIRS = &H1 '仅允许浏览文件系统
Private Const BIF_STATUSTEXT = &H4 '显示状态栏
Private Const BIF_USENEWUI = &H40 '使用新界面(仅支持Win2000、WinME)
Private Const BIF_VALIDATE = &H20 '若输入一个非法文件夹名,就返回BFFM_VALIDATEFAILED 给回调函数
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Function BrowseForFolder(Optional Title As String, Optional hWnd As Long) As String
Dim bi As BROWSEINFO
Dim pidl As Long
Dim folder As String
folder = String(255, vbNullChar)
With bi
.hOwner = hWnd
.ulFlags = BIF_RETURNONLYFSDIRS or BIF_USENEWUI or BIF_EDITBOX
.pidlRoot = 0
.lpszTitle = IIf(Title <> "", Title & vbNullChar, "选择驱动器和目录" & vbNullChar)
End With
pidl = SHBrowseForFolder(bi)
If SHGetPathFromIDList(ByVal pidl, ByVal folder) Then
BrowseForFolder = Left(folder, InStr(folder, vbNullChar) - 1)
Else
BrowseForFolder = ""
End If
End Function
Private Sub Command1_Click()
MsgBox BrowseForFolder
End Sub
Private Type BROWSEINFO
hOwner As Long '父窗口的句柄
pidlRoot As Long '指向希望浏览的最上层的文件夹的标识符列表,可设为0
pszDisplayName As String '返回你所选择的文件夹(带一个NULL字符)
lpszTitle As String '对话框标题(要以vbNullChar结尾)
ulFlags As Long '浏览标志(见下面)
lpfn As Long '回调函数的地址,可设为NULL
lParam As Long '若有回调函数,此项设置它的值
iImage As Long '保存所选文件夹映像索引的缓冲区
End Type
Private Const BIF_BROWSEFORCOMPUTER = &H1000 '允许浏览计算机
Private Const BIF_BROWSEFORPRINTER = &H2000 '允许浏览打印机文件夹
Private Const BIF_BROWSEINCLUDEFILES = &H4000 '允许同时浏览文件(需IE4)
Private Const BIF_DONTGOBELOWDOMAIN = &H2 '强制用户停留在网上邻居中
Private Const BIF_EDITBOX = &H10 '可在输入框中直接输入文件夹名(需IE4)
Private Const BIF_RETURNFSANCESTORS = &H8 '返回文件系统祖先?
Private Const BIF_RETURNONLYFSDIRS = &H1 '仅允许浏览文件系统
Private Const BIF_STATUSTEXT = &H4 '显示状态栏
Private Const BIF_USENEWUI = &H40 '使用新界面(仅支持Win2000、WinME)
Private Const BIF_VALIDATE = &H20 '若输入一个非法文件夹名,就返回BFFM_VALIDATEFAILED 给回调函数
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Function BrowseForFolder(Optional Title As String, Optional hWnd As Long) As String
Dim bi As BROWSEINFO
Dim pidl As Long
Dim folder As String
folder = String(255, vbNullChar)
With bi
.hOwner = hWnd
.ulFlags = BIF_RETURNONLYFSDIRS or BIF_USENEWUI or BIF_EDITBOX
.pidlRoot = 0
.lpszTitle = IIf(Title <> "", Title & vbNullChar, "选择驱动器和目录" & vbNullChar)
End With
pidl = SHBrowseForFolder(bi)
If SHGetPathFromIDList(ByVal pidl, ByVal folder) Then
BrowseForFolder = Left(folder, InStr(folder, vbNullChar) - 1)
Else
BrowseForFolder = ""
End If
End Function
Private Sub Command1_Click()
MsgBox BrowseForFolder
End Sub
评论: 0 | 引用: 0 | 查看次数: 14160