如何在vba中实现目录浏览对话框

有时执行vba程序时，会需要让用户选择目录，下面的代码可以实现目录浏览对话框。

Private Type BrowseInfo
    hOwner As Long
    pIDLRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Private Const BIF_RETURNONLYFSDIRS = &H1

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 Function DialogSelectFolder(hOwner As Long, psTitle As String) As String
    Dim udtBrowseInfo As BrowseInfo, sPath As String
    With udtBrowseInfo
        .hOwner = hOwner
        .pIDLRoot = 0&
        .lpszTitle = psTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    sPath = Space$(512)
    If SHGetPathFromIDList(SHBrowseForFolder(udtBrowseInfo), sPath) Then
        DialogSelectFolder = Left(sPath, InStr(sPath, vbNullChar) - 1)
    Else
        DialogSelectFolder = ""
    End If
End Function

Sub btnFolder_Click()
    DialogSelectFolder 0, "请选择目录"
End Sub

Powered by ScribeFire.