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

http://hi.baidu.com/%B2%BB%B6%A1%B2%BB%C3%AE%CD%C3/blog/item/b5ee2b606152e447eaf8f84b.html

 

1.FileDialog 属性
Sub Sample1()
     With Application.FileDialog(msoFileDialogFolderPicker)
         If .Show = True Then
             MsgBox .SelectedItems(1)
         End If
     End With
End Sub
2.shell 方法
Sub Sample2()
     Dim Shell, myPath
     Set Shell = CreateObject("Shell.Application")
     Set myPath = Shell.BrowseForFolder(&O0, "请选择文件夹", &H1 + &H10, "G:/")
     If Not myPath Is Nothing Then MsgBox myPath.Items.Item.Path
     Set Shell = Nothing
     Set myPath = Nothing
End Sub
3.API 方法
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
                                    (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
                                    (lpBrowseInfo As BROWSEINFO) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long

Public 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


Sub Sample3()
     Dim buf As String
     buf = GetFolder("请选择文件夹")
     If buf = "" Then Exit Sub
     MsgBox buf
End Sub


Function GetFolder(Optional Msg) As String
     Dim bInfo As BROWSEINFO, pPath As String
     Dim R As Long, X As Long, pos As Integer
     bInfo.pidlRoot = 0&
     bInfo.lpszTitle = Msg
     bInfo.ulFlags = &H1
     X = SHBrowseForFolder(bInfo)
     pPath = Space$(512)
     R = SHGetPathFromIDList(ByVal X, ByVal pPath)
     If R Then
         pos = InStr(pPath, Chr$(0))
         GetFolder = Left(pPath, pos - 1)
     Else
         GetFolder = ""
     End If
End Function