关于选择 floder 对话框用什么API

Question

是SHBrowseForFolder.Public Declare Function SHBrowseForFolder Lib "shell32" _
                                  (lpbi As BrowseInfo) As LongPublic Declare Function SHGetPathFromIDList Lib "shell32" _
                                  (ByVal pidList As Long, _
                                  ByVal lpBuffer As String) As LongPublic Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
                                  (ByVal lpString1 As String, ByVal _
                                  lpString2 As String) As LongPublic Type BrowseInfo
   hwndOwner      As Long
   pIDLRoot       As Long
   pszDisplayName As Long
   lpszTitle      As Long
   ulFlags        As Long
   lpfnCallback   As Long
   lParam         As Long
   iImage         As Long
End Type
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260
    Dim lpIDList As Long
    Dim sBuffer As String
    Dim szTitle As String
    Dim tBrowseInfo As BrowseInfo    'szTitle = "Select the save folder"
    With tBrowseInfo
       .hwndOwner = Me.hWnd
       .lpszTitle = lstrcat(szTitle, "Select the save folder")
       .ulFlags = BIF_RETURNONLYFSDIRS
    End With    lpIDList = SHBrowseForFolder(tBrowseInfo)    If (lpIDList) Then
       sBuffer = Space(MAX_PATH)
       SHGetPathFromIDList lpIDList, sBuffer
       sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    End If

Answer 1

要显示在控件中
1.不能.hwndOwner = Me.hWnd
应.hwndOwner = 0
2.
.lpfnHook = AddressOf BrowseCallbackProc
3.在BrowseCallbackProc中
用SetParent

Answer 2

Option ExplicitPrivate Type BrowseInfo
    lngHwnd        As Long
    pIDLRoot       As Long
    pszDisplayName As Long
    lpszTitle      As Long
    ulFlags        As Long
    lpfnCallback   As Long
    lParam         As Long
    iImage         As Long
End TypePrivate Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260Private Declare Sub CoTaskMemFree Lib "ole32.dll" _
    (ByVal hMem As Long)Private Declare Function lstrcat Lib "Kernel32" _
   Alias "lstrcatA" (ByVal lpString1 As String, _
   ByVal lpString2 As String) As Long
   
Private Declare Function SHBrowseForFolder Lib "shell32" _
   (lpbi As BrowseInfo) As Long
   
Private Declare Function SHGetPathFromIDList Lib "shell32" _
   (ByVal pidList As Long, ByVal lpBuffer As String) As LongPublic Function BrowseForFolder(ByVal lngHwnd As Long, ByVal strPrompt As String) As String    On Error GoTo ehBrowseForFolder 'Trap for errors    Dim intNull As Integer
    Dim lngIDList As Long, lngResult As Long
    Dim strPath As String
    Dim udtBI As BrowseInfo    'Set API properties (housed in a UDT)
    With udtBI
        .lngHwnd = lngHwnd
        .lpszTitle = lstrcat(strPrompt, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With    'Display the browse folder...
    lngIDList = SHBrowseForFolder(udtBI)    If lngIDList <> 0 Then
        'Create string of nulls so it will fill in with the path
        strPath = String(MAX_PATH, 0)        'Retrieves the path selected, places in the null
         'character filled string
        lngResult = SHGetPathFromIDList(lngIDList, strPath)        'Frees memory
        Call CoTaskMemFree(lngIDList)        'Find the first instance of a null character,
         'so we can get just the path
        intNull = InStr(strPath, vbNullChar)
        'Greater than 0 means the path exists...
        If intNull > 0 Then
            'Set the value
            strPath = Left(strPath, intNull - 1)
        End If
    End If    'Return the path name
    BrowseForFolder = strPath
    Exit Function 'AbortehBrowseForFolder:    'Return no value
    BrowseForFolder = EmptyEnd Function
---------------------------------
'form code
Option ExplicitPrivate Sub Command1_Click()
    Debug.Print BrowseForFolder(Me.hWnd, "a")
End Sub