如何在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.