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

最新推荐文章于 2025-01-21 20:15:51 发布

转载最新推荐文章于 2025-01-21 20:15:51 发布 · 1.6k 阅读

文章标签：

#vba #function #string #api #shell #path

VB/VBA 专栏收录该内容

3 篇文章

订阅专栏

本文介绍三种在VBA中获取文件夹路径的方法：使用API函数、Shell.Application对象及FileDialog对象。这些方法适用于Windows XP和Office 2003环境。

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

----------------------------------------------------------------------------------------------------------

URL:http://www.officexy.com/Articles/office/VBABasic/20061026103436069.htm