一、使用API方法 

'【类型声明】Private Type BROWSEINFOhWndOwner As LongpIDLRoot As LongpszDisplayName As LonglpszTitle As LongulFlags As LonglpfnCallback As LonglParam As LongiImage As LongEnd Type'【API声明】Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _ByVal pszPath As String) As LongPrivate Declare Function SHBrowseForFolder Lib "shell32.dll" _Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPrivate Declare Function lstrcat Lib "kernel32" _Alias "lstrcatA" (ByVal lpString1 As String, _ByVal lpString2 As String) As LongPrivate Declare Function OleInitialize Lib "ole32.dll" _(lp As Any) As LongPrivate Declare Sub OleUninitialize Lib "ole32" ()Private Const BIF_USENEWUI = &H40Private Const MAX_PATH = 260'【自定义函数】Public Function GetFolder_API(sTitle As String, Optional vFlags As Variant) As StringDim lpIDList As LongDim sBuffer As StringDim BInfo As BROWSEINFOIf IsMissing(vFlags) Then vFlags = BIF_USENEWUICall OleInitialize(ByVal 0&)With BInfo.lpszTitle = lstrcat(sTitle, "").ulFlags = vFlagsEnd WithlpIDList = SHBrowseForFolder(BInfo)If (lpIDList) ThensBuffer = Space(MAX_PATH)SHGetPathFromIDList lpIDList, sBuffersBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)If sBuffer <> "" Then GetFolder_API = sBufferEnd IfCall OleUninitializeEnd Function'【使用方法】Sub Test()MsgBox GetFolder_API("选择文件夹")End Sub

 

二、Shell.Application方法

Sub GetFloder_Shell()Set objShell = CreateObject("Shell.Application")Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)If Not objFolder Is Nothing ThenMsgBox objFolder.self.pathEnd IfSet objFolder = NothingSet objShell = NothingEnd Sub

 

三、使用FileDialog方法

Sub GetFloder_FileDialog()Dim fd As FileDialogSet fd = Application.FileDialog(msoFileDialogFolderPicker)If fd.Show = -1 Then MsgBox fd.SelectedItems(1)Set fd = NothingEnd Sub