on SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As FolderInfor) As Long
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
'定义变量类型
Public Type FolderInfor
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
Sub BrowDir()
Dim iFolder As FolderInfor
Dim pidl As Long, Flag As Long, iPath As String, Pos As Integer, myPath As String
'FindWindow取得Excel窗口的句柄
'在Excel窗口里禁止所有鼠标及键盘输入
EnableWindow FindWindow("XLMAIN", Application.Caption), False
'显示目录选择对话框
pidl = SHBrowseForFolder(iFolder)
'在Excel窗口里允许鼠标及键盘输入
EnableWindow FindWindow("XLMAIN", Application.Caption), True
iPath = Space$(512)
Flag = SHGetPathFromIDList(ByVal pidl, ByVal iPath)
If Flag Then
Pos = InStr(iPath, Chr$(0))
'取得选择的目录
myPath = Left(iPath, Pos - 1)
End If
MsgBox "你选择了 " & myPath
End Sub