Option Explicit Private Type BROWSEINFO hOwner As Long pidlRoot As Long pDisplayName As String lpTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _ "SHGetPathFromIDListA" (ByVal pidl As Long, _ ByVal pPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _ "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _ As Long Private Const BIF_RETURNONLYFSDIRS = &H1 ' ******************************************************************* ' 函数名: BrowseFolder ' 功能: 浏览及选择文件夹通用对话框 ' 使用方法:(1)将mdlBrowseFolder.bas模块添加到当前工程中; ' (2)在当前工程中使用 ' dim strMyPath as String ' strMyPath=BrowseFolder("请选择目录") ' 代码段进行调用,用户选择的目录将保存在strPath字符串变量下; ' (3) 如果用户选择"取消"按钮,则strPath的值为空; ' ******************************************************************* Public Function BrowseFolder(strDialogTitle As String) As String Dim X As Long Dim bi As BROWSEINFO Dim dwIList As Long Dim strPath As String Dim wPos As Integer With bi .hOwner = 0& 'hWndAccessApp .lpTitle = strDialogTitle .ulFlags = BIF_RETURNONLYFSDIRS End With dwIList = SHBrowseForFolder(bi) strPath = Space$(512) X = SHGetPathFromIDList(ByVal dwIList, ByVal strPath) If X Then wPos = InStr(strPath, Chr(0)) BrowseFolder = Left$(strPath, wPos - 1) Else BrowseFolder = vbNullString End If ' 确保返回的路径字符串的最后一个字符为"/" If BrowseFolder <> "" And Right(Trim(BrowseFolder), 1) <> "/" Then BrowseFolder = BrowseFolder & "/" End If End Function ' 测试示例 Sub Main() Dim strMyPath As String strMyPath = BrowseFolder("请选择目录") MsgBox "你选择的路径是: " & strMyPath End Sub