VBA 浏览文件夹对话框调用的几种方法
来源:本站原创|时间:2020-01-10|栏目:vb|点击: 次
1、使用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
2、使用Shell.Application方法
复制代码 代码如下:
Sub GetFloder_Shell()
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)
If Not objFolder Is Nothing Then
MsgBox objFolder.self.path
End If
Set objFolder = Nothing
Set objShell = Nothing
End Sub
3、使用FileDialog方法
复制代码 代码如下:
Sub GetFloder_FileDialog()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then MsgBox fd.SelectedItems(1)
Set fd = Nothing
End Sub
以上方法在WINXP+OFFICE2003中测试通过
您可能感兴趣的文章
- 01-10VBA 中要用到的常数第1/2页
- 01-10windows.vbs.FSO.文件操作信息.磁盘驱动信息.文件夹操作信息全集
- 01-10用vba实现将记录集输出到Excel模板
- 01-10用vbs实现的确定共享文件夹的本地路径?
- 01-10用vbs实现删除名称中有撇号的文件夹
- 01-10用vbs实现在启动 Windows 资源管理器时打开特定文件夹
- 01-10用vbs 实现从剪贴板中抓取一个 URL 然后在浏览器中打开该 Web 站
- 01-10用vbs实现按创建日期的顺序列出一个文件夹中的所有文件
- 01-10用vbs实现取消隐藏文件夹中的所有文件
- 01-10Windows Script Host之用vbs实现[浏览文件夹]功能
阅读排行
本栏相关
- 01-10下载文件到本地运行的vbs
- 01-10飘叶千夫指源代码,又称qq刷屏器
- 01-10SendKeys参考文档
- 01-10什么是一个高效的软件
- 01-10VBS中的正则表达式的用法大全 &l
- 01-10exe2swf 工具(Adodb.Stream版)
- 01-10VBS中SendKeys的基本应用
- 01-10用VBSCRIPT控制ONSUBMIT事件
- 01-10VBScript教程 第十一课深入VBScript
- 01-10VBScript语法速查及实例说明
随机阅读
- 08-05DEDE织梦data目录下的sessions文件夹有什
- 08-05dedecms(织梦)副栏目数量限制代码修改
- 04-02jquery与jsp,用jquery
- 01-10使用C语言求解扑克牌的顺子及n个骰子
- 01-11ajax实现页面的局部加载
- 01-10SublimeText编译C开发环境设置
- 01-10delphi制作wav文件的方法
- 01-10C#中split用法实例总结
- 01-11Mac OSX 打开原生自带读写NTFS功能(图文
- 08-05织梦dedecms什么时候用栏目交叉功能?