OFFICE学习资料 | OFFICE资源下载 | OFFICE知识问答      
设为首页
加入收藏
联系站长
  当前位置:Office学院 >> Office >> VBA 基础 >> 正文
VBA代码调用浏览文件夹对话框的几种方法
[2006年10月26日]  点击数: 【字体: 】【双击滚屏
 

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


我要提问
上一篇:IsEmpty、IsMissing和IsNull有何区别
下一篇:软件界面设计原则
最新文章
也谈数字签名10/26
字符串问题提问答集10/26
Visual Basic的调试和错误处理10/26
VBA系列讲座(1):VBA是什么10/26
VBA系列讲座(2):处理录制的宏10/26
VBA系列讲座(3):学习控件10/26
VBA系列讲座(4):理解变量10/26
VBA系列讲座(5):利用VBA设置工作表使用权限10/26
热门文章
相关文章
利用VBA代码实现Excel中数据快速
VFP调用Excel的方法
VFP5.0 中调用 EXCEL 做报表
VB 调用 Office97 技巧
在Visual C++ 中调用Excel 2000
VB5.0调用Office97技巧
封装我们的VBA代码
也谈PowerPoint中灵活调用MPEG文
office知识问答 | office资源下载
备案许可证号: 津ICP备06003561号
版权所有:Office学院 www.officeXY.com
OFFICE学院致力于成就华人社区最受欢迎的office办公软件学习园地;为大家提供word、excel、access、FrontPage、PowerPoint等Office各个系列产品的最全的教程、用法、技巧、方案;并竭力打造最方便的问题解答系统