这次分享打开选择文件夹窗口的模块,如果把参数WenJian设为True,这样除了可以选择文件夹,还可选择文件。如果把参数RootFolder填一个文件夹路径,这样就会只能选择这个文件夹以及子文件夹和文件,不能选择此文件夹以外的其他内容。
Option ExplicitPrivate Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (LpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDlist Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal Pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHILCreateFromPath Lib "shell32.dll" (ByVal pszPath As String, ppidl As Long, rgflnOut As Long) As LongPrivate Type BROWSEINFO
    hOwner As Long
    pidlroot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lparam As Long
    iImage As Long
End TypePrivate Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_BROWSEINCLUDEFILES = &H4000
Private Const S_OK = &H0Public Function BrowseFolder(ByVal hWnd As Long, Optional Title As String, Optional WenJian As Boolean = False, Optional RootFolder As String) As String
Dim BI As BROWSEINFO, Pidl As Long, FolderPath As String, RootPidl As Long    FolderPath = Space(8192)    With BI
        If IsNumeric(hWnd) Then .hOwner = hWnd
        If WenJian = False Then
            .ulFlags = BIF_RETURNONLYFSDIRS
        Else
            .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_BROWSEINCLUDEFILES
        End If
        If Title <> "" Then
            .lpszTitle = Title
        Else
            .lpszTitle = "请选择文件夹或文件"
        End If
        If RootFolder <> "" Then
            RootFolder = StrConv(RootFolder, vbUnicode)
            If SHILCreateFromPath(RootFolder, RootPidl, ByVal 0) = S_OK Then .pidlroot = RootPidl
        End If
    End With    Pidl = SHBrowseForFolder(BI)
    If SHGetPathFromIDlist(Pidl, FolderPath) Then
        BrowseFolder = Left(FolderPath, InStr(FolderPath, vbNullChar) - 1)
    Else
        BrowseFolder = ""
    End IfEnd Function