文章摘要
这段代码主要实现了对文件夹路径的获取功能。首先定义了`BROWSEINFO`类型，用于描述对话框的显示信息，包括标题、标志位、文本等。接着声明了API函数`SHGetPathFromIDList`和`SHBrowseForFolder`，分别用于从ID列表获取文件路径和打开文件对话框。此外，还声明了其他系统调用函数如`lstrcat`和`OleInitialize`。代码中还定义了自定义函数`GetFolder_API`，该函数通过调用`SHBrowseForFolder`获取文件夹ID列表，并通过`SHGetPathFromIDList`获取文件路径。最后，通过`OleUninitialize`释放资源。`GetFolder_API`函数可以接受可选的标志位参数，并在`Test`方法中被调用以验证功能。
‘【类型声明】
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
‘【API声明】
Private Declare Function SHGetPathFromIDList Lib “shell32.dll” _
Alias “SHGetPathFromIDListA” (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 Sub 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
© 版权声明
文章版权归作者所有，未经允许请勿转载。
