1 Option Explicit  2   3 Private Type BROWSEINFO  4   hOwner As Long  5   pidlRoot As Long  6   pszDisplayName As String  7   lpszTitle As String  8   ulFlags As Long  9   lpfn As Long 10   lParam As Long 11   iImage As Long 12 End Type 13  14 Private Const BIF_RETURNONLYFSDIRS = &H1 '浏览文件夹 15 Private Const BIF_NEWDIALOGSTYLE = &H40 '新样式（有新建文件夹按钮，可调整对话框大小） 16 Private Const BIF_NONEWFOLDERBUTTON = &H200 '新样式中，没有新建按钮（只调大小） 17  18 Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _ 19   (ByVal pidl As Long, _ 20   ByVal pszPath As String) As Long 21 Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _ 22   (lpBrowseInfo As BROWSEINFO) As Long 23  24 Public Function GetFolderName(hWnd As Long, Text As String) As String 25   Dim bi As BROWSEINFO 26   Dim pidl As Long 27   Dim path As String 28   With bi 29     .hOwner = hWnd 30     .pidlRoot = 0&  '根目录，一般不需要改 31     .lpszTitle = Text 32     .ulFlags = BIF_RETURNONLYFSDIRS '根据需要调整 33   End With 34   pidl = SHBrowseForFolder(bi) 35   path = Space$(512) 36   If SHGetPathFromIDList(ByVal pidl, ByVal path) Then 37     GetFolderName = Left(path, InStr(path, Chr(0)) - 1) 38   End If 39 End Function

评论