1、使用API方法复制代码 代码如下:\’【类型声明】 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声明】 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 \’【自定义函数】 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 \’【使用方法】 Sub Test() MsgBox GetFolder_API(\”选择文件夹\”) End Sub 2、使用Shell.Application方法 复制代码 代码如下:Sub GetFloder_Shell() Set objShell = CreateObject(\”Shell.Application\”) Set objFolder = objShell.BrowseForFolder(0, \”选择文件夹\”, 0, 0) If Not objFolder Is Nothing Then MsgBox objFolder.self.path End If Set objFolder = Nothing Set objShell = Nothing End Sub 3、使用FileDialog方法 复制代码 代码如下: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 以上方法在WINXP+OFFICE2003中测试通过
您可能感兴趣的文章:
- VBA 编程基础
- excel vba 高亮显示当前行代码
- Excel VBA连接并操作Oracle
- vba 获取PPT幻灯片中的所有标题的代码
- VBA中连接SQLSERVER数据库例子
- VBA解决Windows空当接龙的617局
