'【
类型声明】
PRivate Ty
PE brOWS
eiNFO
hWndOwner As Long
pIDLRoot As Long
pszDis
playN
ame As Long
lpszT
ITle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
'【API声明】
Private Declare Function SHGetPath
FromIDList Lib "shell32.dll" _
Alias "SHGetPathF
romIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
Private Declare Function OleInitialize Lib "ole32.dll" _
(lp As Any) As Long
Private Declare S
ub OleUninitialize Lib "ole32" ()
Private Const BIF_USENEWUI = &H40
Private Const MAX_PATH = 260
'【自定义函数】
Public Function GetFolder_API(sTitle As String, Optional vFlags As
VARiant) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim BInfo As BROWSEINFO
If IsMissing(vFlags) Then vFlags = BIF_USENEWUI
Call OleInitialize(ByVal 0&)
With BInfo
.lpszTitle = lstrcat(sTitle, "")
.ulFlags = vFlags
End With
lpIDList = SHBrowseForFolder(BInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer,
vbNullChar) - 1)
If sBuffer <> "" Then GetFolder_API = sBuffer
End If
Call OleUninitialize
End Function
'【使用方法】
Sub
test()
MsgBox GetFolder_API("选择文件夹")
End Sub