使用API方法调用浏览文件夹对话框-杨雪
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-模块/函数/VBA


使用API方法调用浏览文件夹对话框

发表时间:2019/6/28 22:18:25 评论(33) 浏览(4187)  评论 | 加入收藏 | 复制
   
摘 要:VBA 使用API方法调用浏览文件夹对话框。
正 文:

源码:

'【类型声明】 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


Access软件网交流QQ群(群号:198465573)
 
 相关文章
用VBA判断指定的excel文件夹或文件是否存在  【网络  2017/8/24】
从FTP下载文件并覆盖到当前文件夹的main文件  【凝听  2017/12/15】
检索指定目录下的文件或文件夹  【布鲁斯  2018/3/20】
【Access示例】批量读取OutLook里的附件并保存到指定文件...  【缪炜  2018/3/25】
【Access示例】读取某文件夹下的所有文件名  【缪炜  2018/9/7】
常见问答
技术分类
相关资源
文章搜索
关于作者

杨雪

文章分类

文章存档

友情链接