vb中有没有像CommonDialog选文件的定位文件夹的控件？

Question

控件的不知道
代码的有Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLISTPublic Type BROWSEINFO    'bi
    'lfont As String
    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 TypeType SHITEMID   'mkid
    cb As Long      'Size of the ID (including cb itself)
    abID As Byte   'The item ID (variable length)
End Type
Type ITEMIDLIST  'idl
    mkid As SHITEMID
End Type
Public Const BIF_RETURNONLYFSDIRS = &H1'  Does not include network folders below the domain level in the tree view control.
'  For starting the Find Computer
Public Const BIF_DONTGOBELOWDOMAIN = &H2'  Includes a status area in the dialog box. The callback function can set
'  the status text by sending messages to the dialog box.
Public Const BIF_STATUSTEXT = &H4'  Only returns file system ancestors. If the user selects anything other
'  than a file system ancestor, the OK button is grayed.
Public Const BIF_RETURNFSANCESTORS = &H8'  Only returns computers. If the user selects anything other
'  than a computer, the OK button is grayed.
Public Const BIF_BROWSEFORCOMPUTER = &H1000'  Only returns (network) printers. If the user selects anything other
'  than a printer, the OK button is grayed.
Public Const BIF_BROWSEFORPRINTER = &H2000Public Const FO_MOVE As Long = &H1
Public Const FO_COPY As Long = &H2
Public Const FO_DELETE As Long = &H3
Public Const FO_RENAME As Long = &H4
Public Const FOF_MULTIDESTFILES As Long = &H1
Public Const FOF_CONFIRMMOUSE As Long = &H2
Public Const FOF_SILENT As Long = &H4
Public Const FOF_RENAMEONCOLLISION As Long = &H8
Public Const FOF_NOCONFIRMATION As Long = &H10
Public Const FOF_WANTMAPPINGHANDLE As Long = &H20
Public Const FOF_CREATEPROGRESSDLG As Long = &H0
Public Const FOF_ALLOWUNDO As Long = &H40
Public Const FOF_FILESONLY As Long = &H80
Public Const FOF_SIMPLEPROGRESS As Long = &H100
Public Const FOF_NOCONFIRMMKDIR As Long = &H200Type 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 TypePublic Function SelectPath(ByVal Control As Form, ByVal Title As String) As String
  Dim bi As BROWSEINFO
  Dim idl As ITEMIDLIST
  Dim rtn&, pidl&, Path$, pos%
  Dim T
  Dim SpecOut, SpecIn As String
  
    bi.hOwner = Control.hwnd 'centres the dialog on the screen
    
    bi.lpszTitle = Title '"Browsing is limited to: " & Option1(CurOptIdx%).Caption
    '  set the type of folder to return
    '  play with these option constants to see what can be returned
    bi.ulFlags = BIF_RETURNONLYFSDIRS 'the type of folder(s) to return
    pidl& = SHBrowseForFolder(bi) 'show the dialog box
    
    Path = Space(512) 'sets the maximum characters
    T = SHGetPathFromIDList(ByVal pidl&, ByVal Path) 'gets the selected path    pos% = InStr(Path$, Chr$(0)) 'extracts the path from the string
    SpecIn = Left(Path$, pos - 1) 'sets the extracted path to SpecIn    If Right$(SpecIn, 1) = "\" Then 'makes sure that "\" is at the end of the path
        SpecOut = SpecIn             'if so then, do nothing
    Else                            'otherwise
        SpecOut = SpecIn + "\"       'add the "\" to the end of the path
    End If
        
    If SpecOut = "\" Then Exit Function
    SelectPath = SpecOut
    End Function

Answer 1

有必要用控件吗？！'写在标准模块中
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 Type
Public 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 2

除了控件，也可以用API
Public Const NOERROR = 0
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000Public Declare Function SHBrowseForFolder Lib "Shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
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 Function ShowFolder() As String
Dim bi As BROWSEINFO
Dim t As Long
Dim FolderPath As String
Dim rtn&, pidl&, path$, pos%bi.hOwner = Me.hWnd
bi.lpszTitle = "选择目录..."
bi.ulFlags = BIF_RETURNONLYFSDIRS
pidl& = SHBrowseForFolder(bi)
  
path = Space(512)
t = SHGetPathFromIDList(ByVal pidl&, ByVal path)
pos% = InStr(path$, Chr$(0))
FolderPath = Left(path$, pos - 1)
ShowFolder = FolderPath
End Function

Answer 3

忘了两个api生命
Public Declare Function SHGetPathFromIDList Lib "Shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "Shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long