- Option Explicit
- Public 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 Const BIF_RETURNONLYFSDIRS = 1
- Private Const MAX_PATH = 260
-
- Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
- Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
-
- 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
-
- Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
-
- '定义变量
- Dim iNull As Integer
- Dim lpIDList As Long
- Dim lResult As Long
- Dim sPath As String
- Dim udtBI As BrowseInfo
-
- '初始化.....
- With udtBI
- .hwndOwner = hwndOwner
- .lpszTitle = lstrcat(sPrompt, "")
- .ulFlags = BIF_RETURNONLYFSDIRS
- End With
-
- '调用API
- lpIDList = 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
- BrowseForFolder = sPath
-
- End Function
直接调用获取路径
- path = BrowseForFolder(hWnd, "请选择一个目录")
hWnd是内置变量,无需定义赋值。
|