在VB中两种方式显示文件夹浏览对话框

在VB中两种方式显示文件夹浏览对话框
 
在VB中想显示文件夹浏览对话框来选择文件夹好像很不容易,今天在网上搜索了一下,大部分都是VC的代码,比较复杂.有VB的也是调了很多API,让人很受不了.后来在VB引用对象中找来找去,终于找到一个很强大的对象Shell.要用它应先引用Microsoft Shell Controls And Automation对象.测试程序如下(其中文件夹浏览一用的是API,二用的是Shell对象):
1.界面:

2.代码:

Private Const BIF_RETURNONLYFSDIRS = 1                                        '从这里开始为API声明                  
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

Dim a As New Shell                                                                                 'Shell对象

Private Sub Command1_Click()                                                              '文件夹浏览一
     Dim lpIDList As Long
     Dim sBuffer As String
     Dim szTitle As String
     Dim tBrowseInfo As BrowseInfo

     szTitle = "This is the title"
     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

Private Sub Command2_Click()                                                             '文件夹浏览二
Dim b As Folder
Set b = a.BrowseForFolder(0, "选择文件夹", 0)
a.Open b
End Sub

原文地址:https://www.cnblogs.com/no7dw/p/1619706.html