'''Module:
 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 Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
 Declare Function lstrcat Lib "Kernel32" Alias "lstrcatA" (ByVal lpString1 As
String, ByVal lpString2 As String) As Long
 Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As Long
 Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As LongPublic Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As StringDim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BROWSEINFOWith udtBI
.hwndOwner = hwndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End WithlpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left(sPath, iNull - 1)
End If
End IfBrowseForFolder = sPathEnd Function'''Form:
Private Sub Command1_Click()
dim strPath As String
 strPath = BrowseForFolder(hwnd, "请选择文件夹:")
......
......
End Sub