Access培訓
網站公告
·Access快速平臺QQ群號:277422564    ·Access快速開發平臺下載地址及教程    ·歡迎添加微信交流賬號:AccessoftChu    ·如何快速搜索本站文章|示例|資料    
您的位置: 首頁 > 技術文章 > Access數據庫-模塊/函數/VBA

使用API方法調用瀏覽文件夾對話框

時 間:2019-06-28 22:18:25
作 者:楊雪   ID:42182  城市:南京
摘 要: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交流群 (群號:198347485)       access源碼網店

最新評論 查看更多評論(33)

2019/7/13 21:43:31楊雪
怎么看不見評論呢?

發表評論您的評論將提升作者分享的動力!快來評論一下吧!

用戶名:
密 碼:
內 容:
 

常見問答

技術分類

相關資源

關于我們 | 服務條款 | 在線投稿 | 友情鏈接 | 網站統計 | 網站幫助