请问：在vb中哪个控件可以实现选择文件夹的功能？（在线等待）

[bluewatermark]

在vb中如何实现选择文件夹的功能？微软有没有提供标准的控件？是什么名字？
问题解决马上给分，先谢了！

[bitsoft]

dirlistbox

[marswang]

DriveListBox 控制項


DriveListBox 控制項可讓使用者在執行階段，選擇一個正確磁碟機。此控制項可用來顯示系統中所有可用的磁碟機的清單。您可以建立對話方塊，透過它從任一個磁碟機的檔案清單中開啟檔案。

語法

DriveListBox

請注意

設定 List、ListCount、和 ListIndex 屬性，就可以存取清單中的項目。如果需要顯示 DirListBox 和 FileListBox 控制項，那麼可以撰寫程式碼，使它們與 DriveListBox 控制項同步，並使它們之間相互同步。

[bluewatermark]

dirlistbox好像只能浏览某个驱动器下的目录
我希望实现的功能是像windows搜索功能中，点击搜索范围中的“浏览...”后，弹出的对话框

[DownFree]

你可以用listbox 把符合你的要求的文件夹添加到listbox项中！
listbox可以添加图标请参照MSDN

[hongsongboy]

用一个模块来实现,我刚学会的.要试试吗

[bitsoft]

抄的斑竹的代码，应该没问题，你试一试：
'Objects: Form1、Command1、Module1
'Form1:
Option Explicit
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Const LPTR = (&H0 Or &H40)
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Function MyAddressOf(AddressOfX As Long) As Long
MyAddressOf = AddressOfX
End Function

Private Sub Command1_Click()
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
Dim Ret As Long
szTitle = "This is the title"
Dim sPath As String
sPath = VBA.InputBox("初始路径:", , "C:\program files")
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
.lpfnCallback = MyAddressOf(AddressOf BrowseForFolders_CallbackProc)
Ret = LocalAlloc(LPTR, VBA.Len(sPath) + 1)
CopyMemory ByVal Ret, ByVal sPath, VBA.Len(sPath) + 1
.lParam = Ret
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = VBA.Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = VBA.Left(sBuffer, VBA.InStr(sBuffer, vbNullChar) - 1)
MsgBox sBuffer
End If
End Sub

'Module1:
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_USER = &H400
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
Private Const BFFM_INITIALIZED As Long = 1
Public Function BrowseForFolders_CallbackProc(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, True, ByVal lpData
End If
End Function