编程知识 购物 网址 新闻 笑话 | 软件 日历 阅读 图书馆 China 头条阅读 学淘股 China Travel
TxT小说阅读器
↓语音阅读,小说下载,古典文学↓
图片批量下载器
↓批量下载图片,美女图库↓
图片自动播放器
↓图片自动播放器↓
一键清除垃圾
↓轻轻一点,清除系统垃圾↓
vbs/VBScript DOS/BAT hta htc python perl 游戏相关 VBA 远程脚本 ColdFusion ruby专题 autoit seraphzone PowerShell linux shell Lua Golang Erlang 其它教程 CSS/HTML/Xhtml html5 CSS XML/XSLT Dreamweaver教程 经验交流
站长资讯 .NET新手 ASP.NET C# WinForm Silverlight WCF CLR WPF XNA VisualStudio ASP.NET-MVC .NET控件开发 EntityFramework WinRT-Metro Java C++ PHP Delphi Python Ruby C语言 Erlang Go Swift Scala R语言 Verilog 其它语言 架构设计 面向对象 设计模式 领域驱动 Html-Css JavaScript jQuery HTML5 SharePoint GIS技术 SAP OracleERP DynamicsCRM K2 BPM 信息安全 企业信息 Android开发 iOS开发 WindowsPhone WindowsMobile 其他手机 敏捷开发 项目管理 软件工程 SQLServer Oracle MySQL NoSQL 其它数据库 Windows7 WindowsServer Linux
   -> VBA -> VBA 浏览文件夹对话框调用的几种方法 -> 正文阅读

[VBA]VBA 浏览文件夹对话框调用的几种方法

VBA 浏览文件夹对话框调用实现代码。大家可以根据需要选择。
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中测试通过
  VBA 最新文章
VBA 中要用到的常数第1/2页
用vba实现将记录集输出到Excel模板
VBA 编程基础
excel vba 限制工作表的滚动区域代码
excel vba 高亮显示当前行代码
当编辑框内容改变 对应的单元格也随着改变v
excel vba 高亮显示当前行代码
vba 获取PPT幻灯片中的所有标题的代码
VBA 中要用到的常数第1/2页
UserAccessList 集合的功能(VBA)
上一篇文章      下一篇文章      查看所有文章
加:2017-05-13 22:40:57  更:2017-05-13 22:41:11 
 
360图书馆 软件开发资料 购物精选 新闻资讯 Chinese Culture 三丰软件 开发 中国文化 阅读网 头条阅读 学淘股 China Travel 日历 万年历 2020年2日历
2020-2-22 18:13:16
多播视频美女直播
↓电视,电影,美女直播,迅雷资源↓
TxT小说阅读器
↓语音阅读,小说下载,古典文学↓
一键清除垃圾
↓轻轻一点,清除系统垃圾↓
图片批量下载器
↓批量下载图片,美女图库↓
  网站联系: qq:121756557 email:121756557@qq.com  编程知识