怎样在VB中弹出选择文件夹的对话框
怎样在VB中弹出选择文件夹的对话框？？
问题点数：20、回复次数：10Top
1 楼happy_sea（开心海(数据读取中，请稍候......)）回复于 2006-11-02 22:51:29 得分 20
先把下面的代码放入BAS模块：
Option Explicit
'common to both methods
Public Type BROWSEINFO
hOwner 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 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 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 Declare Sub MoveMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, _
pSource As Any, _
ByVal dwLength As Long)
Public Const MAX_PATH = 260
Public Const WM_USER = &H400
Public Const BFFM_INITIALIZED = 1
'Constants ending in 'A' are for Win95 ANSI
'calls; those ending in 'W' are the wide Unicode
'calls for NT.
'Sets the status text to the null-terminated
'string specified by the lParam parameter.
'wParam is ignored and should be set to 0.
Public Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Public Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
'If the lParam parameter is non-zero, enables the
'OK button, or disables it if lParam is zero.
'(docs erroneously said wParam!)
'wParam is ignored and should be set to 0.
Public Const BFFM_ENABLEOK As Long = (WM_USER + 101)
'Selects the specified folder. If the wParam
'parameter is FALSE, the lParam parameter is the
'PIDL of the folder to select , or it is the path
'of the folder if wParam is the C value TRUE (or 1).
'Note that after this message is sent, the browse
'dialog receives a subsequent BFFM_SELECTIONCHANGED
'message.
Public Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Public Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
'specific to the PIDL method
'Undocumented call for the example. IShellFolder's
'ParseDisplayName member function should be used instead.
Public Declare Function SHSimpleIDListFromPath Lib _
"shell32" Alias "#162" _
(ByVal szPath As String) As Long
'specific to the STRING method
Public Declare Function LocalAlloc Lib "kernel32" _
(ByVal uFlags As Long, _
ByVal uBytes As Long) As Long
Public Declare Function LocalFree Lib "kernel32" _
(ByVal hMem As Long) As Long
Public Declare Function lstrcpyA Lib "kernel32" _
(lpString1 As Any, lpString2 As Any) As Long
Public Declare Function lstrlenA Lib "kernel32" _
(lpString As Any) As Long
Public Const LMEM_FIXED = &H0
Public Const LMEM_ZEROINIT = &H40
Public Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)
Public Function BrowseCallbackProcStr(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long
'Callback for the Browse STRING method.
'On initialization, set the dialog's
'pre-selected folder from the pointer
'to the path allocated as bi.lParam,
'passed back to the callback as lpData param.
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hWnd, BFFM_SETSELECTIONA, _
True, ByVal StrFromPtrA(lpData))
Case Else:
End Select
End Function
Public Function BrowseCallbackProc(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long
'Callback for the Browse PIDL method.
'On initialization, set the dialog's
'pre-selected folder using the pidl
'set as the bi.lParam, and passed back
'to the callback as lpData param.
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hWnd, BFFM_SETSELECTIONA, _
False, ByVal lpData)
Case Else:
End Select
End Function
Public Function FARPROC(pfn As Long) As Long
'A dummy procedure that receives and returns
'the value of the AddressOf operator.
'Obtain and set the address of the callback
'This workaround is needed as you can't assign
'AddressOf directly to a member of a user-
'defined type, but you can assign it to another
'long and use that (as returned here)
FARPROC = pfn
End Function
Public Function StrFromPtrA(lpszA As Long) As String
'Returns an ANSI string from a pointer to an ANSI string.
Dim sRtn As String
sRtn = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal sRtn, ByVal lpszA)
StrFromPtrA = sRtn
End Function
'--end block--'
将下面代码加入窗体。窗体上还应放置三个按钮和两个TextBox。
Option Explicit
Private Sub cmdString_Click()
Text2 = ""
Text2 = BrowseForFolderByPath((Text1))
End Sub
Private Sub cmdPIDL_Click()
Text2 = ""
Text2 = BrowseForFolderByPIDL((Text1))
End Sub
Private Sub cmdEnd_Click()
Unload Me
End Sub
Public Function BrowseForFolderByPath(sSelPath As String) As String
Dim BI As BROWSEINFO
Dim pidl As Long
Dim lpSelPath As Long
Dim sPath As String * MAX_PATH
With BI
.hOwner = Me.hWnd
.pidlRoot = 0
.lpszTitle = "Pre-selecting the folder using the folder's string."
.lpfn = FARPROC(AddressOf BrowseCallbackProcStr)
lpSelPath = LocalAlloc(LPTR, Len(sSelPath))
MoveMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath)
.lParam = lpSelPath
End With
pidl = SHBrowseForFolder(BI)
If pidl Then
If SHGetPathFromIDList(pidl, sPath) Then
BrowseForFolderByPath = Left$(sPath, InStr(sPath, vbNullChar) - 1)
End If
Call CoTaskMemFree(pidl)
End If
Call LocalFree(lpSelPath)
End Function
Public Function BrowseForFolderByPIDL(sSelPath As String) As String
Dim BI As BROWSEINFO
Dim pidl As Long
Dim sPath As String * MAX_PATH
With BI
.hOwner = Me.hWnd
.pidlRoot = 0
.lpszTitle = "Pre-selecting a folder using the folder's pidl."
.lpfn = FARPROC(AddressOf BrowseCallbackProc)
.lParam = SHSimpleIDListFromPath(sSelPath)
End With
pidl = SHBrowseForFolder(BI)
If pidl Then
If SHGetPathFromIDList(pidl, sPath) Then
BrowseForFolderByPIDL = Left$(sPath, InStr(sPath, vbNullChar) - 1)
End If
Call CoTaskMemFree(pidl)
End If
Call CoTaskMemFree(BI.lParam)
End Function
Top
2 楼BUGStudio（BUG）回复于 2006-11-03 21:22:16 得分 0
这麽多，，有没简单的？？
Top
3 楼YaDa（）回复于 2006-11-03 21:36:51 得分 0
这个好.留名作记.Top
4 楼happy_sea（开心海(数据读取中，请稍候......)）回复于 2006-11-04 00:26:16 得分 0
楼主有点不识货哈，这个代码可是很经典的，弹出选择文件夹窗口时能设置起始路径，而不必每次都从桌面开始，至于窗口标题自己改一下.lpszTitle就行了，比如起始为c:\windows文件夹：
private sub command1_click()
msgbox "你选择了" & BrowseForFolderByPath("c:\windows")
end subTop
5 楼cike_1111（）回复于 2006-11-04 10:13:00 得分 0
弹出 选择文件夹窗口 ？？？ 不太理解这个概念！
不过ＶＢ不是有个控件么！
commondialog控件！
部件引用：Microsoft Common Dialog Control 6.0()
语法：
ommondialog.打开类型
打开类型=1 打开文件对话框
打开类型=2 另存为文件对话框
打开类型=3 颜色对话框
打开类型=4 字体对话框
打开类型=5 打印对话框
然后用 showopen语句 打开一个对话框！ 不知道楼主说的是这个么！Top
6 楼hpygzhx520（）回复于 2006-11-04 10:56:26 得分 0
楼上的初学啊？这个可以选择文件但不能选择文件夹
另外一问：这个能否做到窗体里面？Top
7 楼ProgramFanA（零零发）回复于 2006-11-04 12:54:49 得分 0
看我写的：
clsChooseDir类代码如下：
Option Explicit
'API声明部分
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Type BROWSEINFO
hOwner 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
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Const BIF_RETURNONLYFSDIRS = 0
Private Const BIF_DONTGOBELOWDOMAIN = 1
Private Const BIF_STATUSTEXT = 2
Private Const BIF_RETURNFSANCESTORS = 3
Private Const BIF_BROWSEFORCOMPUTER = 4
Private Const BIF_BROWSEFORPRINTER = 5
'变量声明
Private mvarCaption As String
Private mvarhWnd As Long
Private mvarFlags As Integer
Private mvarFolder As Variant
'类的属性
Public Property Let Folder(ByVal vData As Variant)
mvarFolder = vData
End Property
Public Property Set Folder(ByVal vData As Variant)
Set mvarFolder = vData
End Property
Public Property Get Folder() As Variant
If IsObject(mvarFolder) Then
Set Folder = mvarFolder
Else
Folder = mvarFolder
End If
End Property
Public Property Let Flags(ByVal vData As Integer)
mvarFlags = vData
End Property
Public Property Get Flags() As Integer
Flags = mvarFlags
End Property
Public Property Let hwnd(ByVal vData As Long)
mvarhWnd = vData
End Property
Public Property Get hwnd() As Long
hwnd = mvarhWnd
End Property
Public Property Let Caption(ByVal vData As String)
mvarCaption = vData
End Property
Public Property Get Caption() As String
Caption = mvarCaption
End Property
'类的方法
Public Sub GetFolder()
Dim bi As BROWSEINFO
Dim pidl As Long
Dim ret As String
ret = String$(255, Chr$(0))
With bi
.hOwner = hwnd
.ulFlags = Flags
If Caption <> "" Then
.lpszTitle = Caption & Chr$(0)
Else
.lpszTitle = "Select a Folder..." & Chr$(0)
End If
End With
pidl = SHBrowseForFolder(bi)
If SHGetPathFromIDList(ByVal pidl, ByVal ret) Then
Folder = Left$(ret, InStr(ret, Chr$(0)) - 1)
If Right(Folder, 1) <> "\" Then
Folder = Folder & "\"
End If
Else
Folder = ""
End If
End Sub
使用：
Dim c As clsChooseDir
Set c = New clsChooseDir
With c
.Caption = "请选择一个文件夹"
.Flags = 0
.hwnd = Me.hwnd
End With
c.GetFolder
txtPath.Text = c.Folder
Top
8 楼BUGStudio（BUG）回复于 2006-11-06 20:40:04 得分 0
to:happy_sea(开心海(数据读取中，请稍候......))
呵呵，，先谢了。。
那段代码我已经收下了。。
我以为在 VB 中有类似“commondialog”的控件来。。
Top
9 楼popxhl（）回复于 2006-12-10 16:43:35 得分 0
楼上的兄弟们辛苦了,用控件做的不够环保,用API好Top
10 楼mygia（www.gzcost.com）回复于 2007-01-26 14:13:14 得分 0
好咚咚，刚好解决了我的问题。Top
