如何使用API函数使用目录框的浏览，并能指定默认打开的目录？

Question

直接用commanddialog控件吧。 

Answer 1

Const LPTR = (&H0 Or &H40)Private Sub Command1_Click()
    Dim lpbi As BROWSEINFO
    
    Dim dReturn As Long
    Dim dwReturn As Long
    Dim sPath As String
    Dim lPathPtr As Long
    
    lPathPtr = LocalAlloc(LPTR, Len(Text1.Text) + 1)
    CopyMemory ByVal lPathPtr, ByVal Text1.Text, Len(Text1.Text) + 1
    
    With lpbi
        .hWndOwner = Me.hWnd
        .lpszTitle = "Please select a folder:"
        .ulFlags = BIF_BROWSEINCLUDEFILES Or _
                   BIF_EDITBOX Or _
                   BIF_STATUSTEXT
        .lpfnCallback = FARPROC(AddressOf BrowseCallbackProc)
        .lParam = lPathPtr
        .pszDisplayName = Space$(MAX_PATH)
    End With    dReturn = SHBrowseForFolder(lpbi)
    
    If dReturn Then
        sPath = Space$(MAX_PATH)
        dwReturn = SHGetPathFromIDList(dReturn, sPath)
        
        If dwReturn Then
            Text2.Text = Left(sPath, _
                            InStr(sPath, vbNullChar) - 1)
        End If
    End If
    
    LocalFree lPathPtr
End Sub
模块
Public Const MAX_PATH = 260Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_EDITBOX = &H10
Public Const BIF_VALIDATE = &H20
Public Const BIF_USENEWUI = &H40
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const BIF_BROWSEINCLUDEFILES = &H4000' Message from BrowserPublic Const BFFM_INITIALIZED = &H1
Public Const BFFM_SELCHANGED = &H2
Public Const BFFM_VALIDATEFAILEDA = &H3
Public Const BFFM_VALIDATEFAILEDW = &H4' Messages to Browser
Public Const WM_USER = &H400Public Const BFFM_SETSTATUSTEXTA As Long = &H400 + 100
Public Const BFFM_ENABLEOK As Long = &H400 + 101
Public Const BFFM_SETSELECTIONA As Long = &H400 + 102
Public Const BFFM_SETSELECTIONW As Long = &H400 + 103
Public Const BFFM_SETSTATUSTEXTW As Long = &H400 + 104
Public Const BFFM_VALIDATEFAILED = BFFM_VALIDATEFAILEDA
Public Const BFFM_SETSTATUSTEXT = BFFM_SETSTATUSTEXTA
Public Const BFFM_SETSELECTION = BFFM_SETSELECTIONAPublic Type BROWSEINFO
    hWndOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End TypePublic Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" _
    (lpbi As BROWSEINFO) As LongPublic Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
   (ByVal hWndOwner As Long, _
    ByVal nFolder As Long, _
    pidl As Long) As Long
    
Public Declare Function SHGetPathFromIDList Lib "shell32" _
    (ByVal pidList As Long, _
    ByVal lpBuffer As String) As LongPublic Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (pDest As Any, _
    pSource As Any, _
    ByVal dwLength As Long)Public Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" _
    (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As LongPublic Declare Function LocalAlloc Lib "kernel32" _
    (ByVal uFlags As Long, _
    ByVal uBytes As Long) As LongPublic Declare Function LocalFree Lib "kernel32" _
    (ByVal hMem As Long) As Long'int CALLBACK BrowseCallbackProc(
'    HWND hwnd,
'    UINT uMsg,
'    LPARAM lParam,
'    lParam lpData
'    );Public Function BrowseCallbackProc(ByVal hWnd As Long, _
    ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
    
    Dim dwReturn As Long
    Dim lpBuffer As String
    
    If uMsg = BFFM_INITIALIZED Then
        SendMessage hWnd, BFFM_SETSELECTION, True, ByVal lpData
    ElseIf uMsg = BFFM_SELCHANGED Then
        lpBuffer = Space(MAX_PATH)
        
        dwReturn = SHGetPathFromIDList(lParam, lpBuffer)
        
        If dwReturn Then
            SendMessage hWnd, BFFM_SETSTATUSTEXT, False, ByVal lpBuffer
        End If
    End If
    
    BrowseCallbackProc = 0
End FunctionPublic Function FARPROC(lFuncAddr As Long) As Long
    FARPROC = lFuncAddr
End Function

Answer 2

  打开目录：sehll("explorer /e," & strDir)
  如：   strDir="c:\winnt"

Answer 3

http://ygyuan.go.163.com/
http://ygyuan.3322.net/
有代码下载.