VB怎么打开这样的文件夹浏览对话框

VB如何打开这样的文件夹浏览对话框？
VB 文件夹浏览对话框
[解决办法]
引用ms common diaolog 控件
[解决办法]
本帖最后由 bcrun 于 2013-05-19 15:09:04 编辑

Private Const BIF_BROWSEINCLUDEFILES = &H4000  '// Browsing for Everything

Private 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 Type

'API's for selecting a windows directory
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Public Function GetDirectory(hWnd As Long) As String
    Dim bi As BROWSEINFO
    Dim pidl As Long
    Dim Path As String, Pos As Long

    bi.hOwner = hWnd
    bi.pidlRoot = 0&
    bi.lpszTitle = "选择文件夹..."
    bi.ulFlags = BIF_RETURNONLYFSDIRS
    pidl = SHBrowseForFolder(bi)
    Path = Space$(256)

    If SHGetPathFromIDList(ByVal pidl, ByVal Path) Then
        Pos = InStr(Path, Chr$(0))
        GetDirectory = Left$(Path, Pos - 1)
    End If
    
    Call CoTaskMemFree(pidl)
End Function

'Public Function GetStrByteNum(s As String) As Long
'    GetStrByteNum = LenB(StrConv(s, vbFromUnicode))
'End Function

可以做，但是很麻烦。

首先你要很精通api和窗口hook。

思路是

http://msdn.microsoft.com/en-us/library/windows/desktop/ms646960(v=vs.85).aspx#_win32_Explorer_Style_Hook_Procedures

Open and Save As Dialog Box Customization 小节介绍的对话框挂钩方式，你可以移除文件类型的下拉，以及不允许选择文件。
[解决办法]
有一个变通的办法，还是使用ms common dialog组件

Private Sub Form_Load()

    With CommonDialog1
        .Flags = cdlOFNPathMustExist
        .Flags = .Flags Or cdlOFNHideReadOnly
        .Flags = .Flags Or cdlOFNNoChangeDir
        .Flags = .Flags Or cdlOFNExplorer
        .DialogTitle = lang_select_folder
        .FileName = "请进入一个目录后选择"
        .CancelError = True
    End With

    '此遇错继续是处理选择目录框点击“取消”的行为
    On Error Resume Next
    CommonDialog1.ShowOpen
    If Err.Number = cdlCancel Then Exit Sub
    Err.Clear
    On Error GoTo 0

    MsgBox Left(CommonDialog1.FileName, Len(CommonDialog1.FileName) - Len(CommonDialog1.FileTitle))

End Sub