Option Explicit

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 Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem 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

Const BIF_RETURNONLYFSDIRS = 1 Const MAX_PATH = 260

Private Sub Command1_Click() Dim SearchPath As String Dim sPath As String, udtBI As BrowseInfo Dim lpIDList As Long, iNull As Long With udtBI '设置浏览窗口 .hWndOwner = Me.hWnd '返回选中的目录 .ulFlags = BIF_RETURNONLYFSDIRS End With '调出浏览窗口 lpIDList = SHBrowseForFolder(udtBI) If lpIDList Then sPath = String$(MAX_PATH, 0) '获取路径 SHGetPathFromIDList lpIDList, sPath '释放内存 CoTaskMemFree lpIDList iNull = InStr(sPath, vbNullChar) If iNull Then sPath = Left$(sPath, iNull - 1) End If MsgBox "你选择的目录是" & sPath End If End Sub