vb中5种打开文件夹浏览框的方法总结
文章录入：浣花溪
责任编辑：snow 1038
【字体：小 大】
by daokers
众所周知，在vb中如果是打开某一个文件的话，非常简单，使用CommonDialog组件即可轻松完成，但是他只能选择文件，之后或许选取的文件路径，而如果想要浏览文件夹，就没这么方便了。
这里介绍3个办法来实现文件夹浏览。
第一个非常简单，利用Shell对象
程序代码
\'引用Microsoft Shell Controls And Automation Dim ShellA As New Shell Dim Shellb As Folder Set Shellb = ShellA.BrowseForFolder(0, \"选择文件夹\", Private Sub Command1_Click()
\'建立一个按钮对象
0) ShellA.Open b End Sub
记得一定要引用Microsoft Shell Controls And Automation
第二种方法，我们同样利用shell对象，但是加几个函数
程序代码
\'引用Microsoft Shell Controls And Automation Private shlShell As Shell32.Shell Private shlFolder As Shell32.Folder Private Const BIF_RETURNONLYFSDIRS = &H1 Private Sub Command1_Click() \'
If shlShell Is Nothing Then
Set shlShell = New Shell32.Shell
End If
Set
shlFolder
= shlShell.BrowseForFolder(Me.hWnd, \"请选择文件夹\", BIF_RETURNONLYFSDIRS)
If Not shlFolder Is Nothing Then
MsgBox shlFolder.Items.Item.Path \'测试
End If End Sub
上面2个方法的结果如图：
第三个方法，是利用API来操作。
程序代码
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 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 Sub Command1_Click()
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = App.Path
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, \"\")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer vbNullChar)1)
BrowseForFolder = sBuffer
Else
BrowseForFolder = \"\"
End If
End Function
Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
Dim lpIDList As Long
Dim ret As Long
Dim sBuffer As String
On Error Resume Next
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMeage(hWnd, BFFM_SETSelectION, 1, m_CurrentDirectory)
Case BFFM_SELCHANGED
sBuffer = Space(MAX_PATH)
ret = SHGetPathFromIDList(lp, sBuffer)
If ret = 1 Then
Call
End If
End Select
BrowseCallbackProc = 0
End Function Private Function GetAddreofFunction(add As Long) As Long
GetAddreofFunction = add
SendMeage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer) End Function
建立一个窗口和一个按钮
程序代码 Option Explicit Private getdir As String Private Sub Command1_Click()
getdir = BrowseForFolder(Me, \"Select A Directory\", Text1.Text)
If Len(getdir) = 0 Then Exit Sub
Text1.Text = getdir
End Sub Private Sub Form_Load()
Text1.Text = CurDir End Sub
最终结果如图：
上面是对vb中调用文件夹对话框的一个总结，个人认为第5个方法是最为完美的，这也是从国外坛子淘到的
不得不说，国外对源码共享还是走在我们前面的。
摘自红色黑客联盟(www.7747.net) 原文：http://www.7747.net/kf/201003/45541.html
