[VB]用API打开浏览文件夹对话框，选择文件夹

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