关于调用WINDOWS浏览文件夹的问题

Question

Public Declare Function SHBrowseForFolder _
        Lib "shell32.dll" Alias "SHBrowseForFolderA" _
        (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList _
        Lib "shell32.dll" _
        (ByVal pidl As Long, _
        pszPath As String) As LongPublic Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlage As Long
    lpfn As Long
    lparam As Long
    iImage As Long
End TypePublic Function ShowDir(MehWnd As Long, _
        DirPath As String, _
        Optional Title As String = "请选择文件夹：", _
        Optional flage As Long = &H1, _
        Optional DirID As Long) As Long
    Dim BI As BROWSEINFO
    Dim TempID As Long
    Dim TempStr As String
    
    TempStr = String$(255, Chr$(0))
    With BI
        .hOwner = MehWnd
        .pidlRoot = 0
        .lpszTitle = Title + Chr$(0)
        .ulFlage = flage
        
    End With
    
    TempID = SHBrowseForFolder(BI)
    DirID = TempID
    
    If SHGetPathFromIDList(ByVal TempID, ByVal TempStr) Then
        DirPath = Left$(TempStr, InStr(TempStr, Chr$(0)) - 1)
        ShowDir = -1
        
    Else
        ShowDir = 0
        
    End If
    
End Function

Answer 1

Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Const FO_COPY = &H2
Public Const FO_DELETE = &H3
Public Const FOF_ALLOWUNDO = &H40
Public 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
Public Type SHFILEOPSTRUCT
     hwnd As Long
     wFunc As Long
     pFrom As String
     pTo As String
     fFlags As Long
     fAnyOperationsAborted As Long
     hNameMappings As Long
     lpszProgressTitle As String
End Type
Const BIF_RETURNONLYFSDIRS = &H1
Public pidl As Long
Function OpenDir(Mhwnd As Long)
    Dim bi As BROWSEINFO
    Dim r As Long
    Dim pidl As Long
    Dim path As String
    Dim pos As Integer
    bi.hOwner = Mhwnd
    '展开根目录
    bi.pidlRoot = 0&
    '列表框标题
    bi.lpszTitle = "请选择文件保存路径："
    '规定只能选择文件夹，其他无效
    bi.ulFlags = BIF_RETURNONLYFSDIRS
    '调用API函数显示列表框
    pidl = SHBrowseForFolder(bi)
    '利用API函数获取返回的路径
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal pidl&, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        OpenDir = Left(path, pos - 1)
    Else
        OpenDir = ""
    End If
End Function
使用方法：
在你需要的地方用：
FilePath = OpenDir(Me.hWnd)
就可以了，比MsgBox使用还方便！
--------------------------------------------------------------------
欢迎使用Fantasia Photo(http://3rdapple.51.net/FantasiaPhoto.htm)
--------------------------------------------------------------------
Made by Thirdapple's Studio(http://3rdapple.51.net/)

Answer 2

没看清楚
需要设置回掉函数http://www.applevb.com/sourcecode/2054_EBrowseF.zip
SHBrowseForFolder函数大家可能用过，这个代码展示了一个扩充用法，可以让你在Dialog中选择的时候就显示选择了那个目录。