VBA Browsing Folders dialog box calls several methods _vba

1, using the API method

Copy Code code as follows:

' Type declaration '
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 declaration '
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
' Custom function '
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
' Use method '
Sub Test ()
MsgBox getfolder_api ("Select Folder")
End Sub

2. Using Shell.Application method

Copy Code code as follows:

Sub Getfloder_shell ()
Set Objshell = CreateObject ("Shell.Application")
Set objfolder = Objshell.browseforfolder (0, "Select Folder", 0, 0)
If not objfolder are nothing Then
MsgBox ObjFolder.self.path
End If
Set objfolder = Nothing
Set Objshell = Nothing
End Sub

3. Using FileDialog method

Copy Code code as follows:

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

The above method is tested in winxp+office2003 through