vb中5种打开文件夹浏览框的方法总结

by daokers

众所周知，在vb中如果是打开某一个文件的话，非常简单，使用CommonDialog组件即可轻松完成，但是他只能选择文件，之后或许选取的文件路径，而如果想要浏览文件夹，就没这么方便了。

这里介绍3个办法来实现文件夹浏览。

第一个非常简单，利用Shell对象
程序代码
引用Microsoft Shell Controls And Automation
Dim ShellA As New Shell
Private Sub Command1_Click() 建立一个按钮对象
Dim Shellb As Folder
Set Shellb = ShellA.BrowseForFolder(0, "选择文件夹", 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 = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
          MsgBox sBuffer
     End If
End Sub

如果希望对话框中有“新建文件夹”，那么就给.ulFlags 加上BIF_USENEWUI属性，BIF_RETURNONLYFSDIRS 的意思是仅仅返回文件夹。
效果如图：
点击放大图片

同时我也打包2个完整的利用此API的代码，有意者请自己学习了。

第4个方法。
其实是第三个方法的改进，就是打开对话框后，自动定位到当前文件夹位置。

程序代码

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   
          &nbs						
		
	

补充：软件开发 , Vb ,