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

页面导航:首页 > 脚本专栏 > VBA > VBA 浏览文件夹对话框调用的几种方法

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

来源:互联网 作者:脚本宝典 时间:2015-07-22 13:03 【

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 Typ

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中测试通过


Tags:

文章评论

最 近 更 新
热 点 排 行
Js与CSS工具
代码转换工具

<