2.代码:

Private Const BIF_RETURNONLYFSDIRS = 1                                        '从这里开始为API声明                  Private Const BIF_DONTGOBELOWDOMAIN = 2Private 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 LongEnd 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 FolderSet b = a.BrowseForFolder(0, "选择文件夹", 0)a.Open bEnd Sub