足球游戏_中国足彩网¥体育资讯$

VBA 浏览文件夹对话框调用的几种方法
来源:易贤网 阅读:1399 次 日期:2014-09-25 11:56:49
温馨提示:易贤网小编为您整理了“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中测试通过

中国足彩网信息请查看IT技术专栏

中国足彩网信息请查看脚本栏目
由于各方面情况的不断调整与变化,易贤网提供的所有考试信息和咨询回复仅供参考,敬请考生以权威部门公布的正式信息和咨询为准!
关于我们 | 联系我们 | 人才招聘 | 网站声明 | 网站帮助 | 非正式的简要咨询 | 简要咨询须知 | 加入群交流 | 手机站点 | 投诉建议
工业和信息化部备案号:滇ICP备2023014141号-1 足球游戏_中国足彩网¥体育资讯$ 滇公网安备53010202001879号 人力资源服务许可证:(云)人服证字(2023)第0102001523号
云南网警备案专用图标
联系电话:0871-65317125(9:00—18:00) 获取招聘考试信息及咨询关注公众号:hfpxwx
咨询QQ:526150442(9:00—18:00)版权所有:易贤网
云南网警报警专用图标