打开文件用CommonDialog，打开文件夹(目录)用什么

Question

打开文件用CommonDialog，打开文件夹(目录)用什么就像winamp播放->文件夹那样的打开目录的对话框用的是什么控件

Answer 1

'用CommonDialog控件Private Sub Command1_Click()
    Me.CommonDialog1.InitDir = "c:\"
    Me.CommonDialog1.ShowOpen
End Sub

Answer 2

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
        "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPrivate Declare Function SHGetSpecialFolderLocation Lib _
        "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder _
        As Long, pIdl As ITEMIDLIST) As LongPrivate Declare Function SHGetFileInfo Lib "Shell32" Alias _
        "SHGetFileInfoA" (ByVal pszPath As Any, ByVal _
        dwFileAttributes As Long, psfi As SHFILEINFO, ByVal _
        cbFileInfo As Long, ByVal uFlags As Long) As LongPrivate Declare Function ShellAbout Lib "shell32.dll" Alias _
        "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As _
        String, ByVal szOtherStuff As String, ByVal hIcon As Long) _
        As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
        Alias "SHGetPathFromIDListA" (ByVal pIdl As Long, ByVal _
        pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)Const MAX_PATH = 260Private Type SHITEMID
    cb As Long
    abID() As Byte
End TypePrivate Type ITEMIDLIST
    mkid As SHITEMID
End TypePrivate 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 Type SHFILEINFO
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName As String * MAX_PATH
    szTypeName As String * 80
End Type
Private Function GetFolderValue(wIdx As Integer) As Long
    If wIdx < 2 Then
        GetFolderValue = 0
    ElseIf wIdx < 12 Then
        GetFolderValue = wIdx
    Else
        GetFolderValue = wIdx + 4
    End If
End FunctionPrivate Sub Command1_Click()
  Dim BI As BROWSEINFO
  Dim nFolder As Long
  Dim IDL As ITEMIDLIST
  Dim pIdl As Long
  Dim sPath As String
  Dim SHFI As SHFILEINFO
  Dim m_wCurOptIdx As Integer
  Dim txtPath As String
  Dim txtDisplayName As String
  
  With BI
    .hOwner = Me.hwnd
    nFolder = GetFolderValue(m_wCurOptIdx)
    
    If SHGetSpecialFolderLocation(ByVal Me.hwnd, ByVal nFolder, IDL) = NOERROR Then
      .pidlRoot = IDL.mkid.cb
    End If
    
    .pszDisplayName = String$(MAX_PATH, 0)
    .lpszTitle = "Browsing is limited to: "
    .ulFlags = 0
  End With
  
  txtPath = ""
  txtDisplayName = ""
  
  pIdl = SHBrowseForFolder(BI)
  
  If pIdl = 0 Then Exit Sub
  sPath = String$(MAX_PATH, 0)
  SHGetPathFromIDList ByVal pIdl, ByVal sPath  txtPath = Left(sPath, InStr(sPath, vbNullChar) - 1)
  txtDisplayName = Left$(BI.pszDisplayName, _
                    InStr(BI.pszDisplayName, vbNullChar) - 1)
  
  SHGetFileInfo ByVal pIdl, 0&, SHFI, Len(SHFI), _
                SHGFI_PIDL Or SHGFI_ICON Or SHGFI_SMALLICON
  
  SHGetFileInfo ByVal pIdl, 0&, SHFI, Len(SHFI), _
                SHGFI_PIDL Or SHGFI_ICON
  CoTaskMemFree pIdl
  MsgBox "你选择的文件夹是" + Chr(13) + Chr(10) + txtPath
End Sub

Answer 3

致：龙卷风V2.0 
每次看到你回帖都是：
 通篇的API
 通篇的没有注释
 通篇的看不懂
连个学习的机会也没有啊！1

Answer 4

http://www.yesky.com/20011026/202297.shtml
这里有比较详细的解释to 楼上
你去下载一个api guide或者去google搜索以后我会增加注释的，谢谢提醒

Answer 5

用script.filesystemobject对象遍历目录.自己写了生成目录树也行啊.

Answer 6

Me.CommonDialog1.InitDir = "c:\"
    Me.CommonDialog1.ShowOpen

Answer 7

Public Enum EnumRootFolder
    fbfDeskTop = &H0
    fbfPrograms = &H2
    fbfControls = &H3
    fbfPrinters = &H4
    fbfPersonal = &H5
    fbfFavorites = &H6
    fbfStartup = &H7
    fbfRecent = &H8
    fbfSendTo = &H9
    fbfBitbucket = &HA
    fbfStartMenu = &HB
    fbfDesktopDirectory = 16
    fbfDrives = &H11
    fbfNetWork = &H12
    fbfNetHood = &H13
    fbfFonts = &H14
    fbfTemplates = &H15
End Enum
Public Enum EnumChoose
    fbcFolders = &H1
    fbcComputers = &H1000
    fbcPrinters = &H2000
    fbcEverything = &H4000
End EnumPublic Function ChooseFolder(hWnd As Long, Message As String, Seleted As String, Optional RootFolder As EnumRootFolder = EnumRootFolder.fbfDrives, Optional ChooseWho As EnumChoose = EnumChoose.fbcFolders) As Boolean
'选择目录对话框
    On Error GoTo er
    Dim Nullpos As Integer
    Dim lpIDList As Long
    Dim res As Long
    Dim sPath As String
    Dim Binfo As BrowseInfo
    Dim RootID As Long
    mPath = Seleted
    With Binfo
    .hWndOwner = hWnd
    .lpszTitle = Message
    .ulFlags = BIF_STATUSTEXT Or ChooseWho
    .pIDLRoot = RootFolder
    .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)
    If RootID <> 0 Then .pIDLRoot = RootID
    End With
    lpIDList = SHBrowseForFolder(Binfo)
    ChooseFolder = IIf(lpIDList <> 0, True, False)
    If lpIDList <> 0 Then
        sPath = String(260, Chr(0))
        res = SHGetPathFromIDList(lpIDList, sPath)
        Nullpos = InStr(sPath, vbNullChar)
        If Nullpos Then
            Seleted = Left(sPath, Nullpos - 1)
        End If
    End If
    Exit Function
er:
    ChooseFolder = False
End FunctionPublic Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
    Dim lpIDList As Long
    Dim ret As Long
    Dim sBuffer As String
    On Error Resume Next
    Select Case uMsg
        Case BFFM_INITIALIZED: Call SendMessageString(hWnd, BFFM_SETSELECTION, 1, mPath)
        Case BFFM_SELCHANGED
            sBuffer = Space(260)
            ret = SHGetPathFromIDList(lp, sBuffer)
            If ret = 1 Then Call SendMessageString(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
        End Select
    BrowseCallbackProc = 0
End Function

Answer 8

Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)Private Declare Function SendMessageString Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As LongPrivate Function GetAddressofFunction(Add As Long) As Long
  GetAddressofFunction = Add
End Function