[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

 

转载于:https://www.cnblogs.com/xxaxx/archive/2010/11/07/1871323.html