关于commondialog问题，在线等。。。。。

Question

小弟想用commondialog做一个“另存为”对话框，要求是只要选择目录，不能选择文件名（因为要保存多个文件）。
用什么方法可以做到？
如果不能，还有其他方法吗？

Answer 1

问题是Drive控件不能显示网络的资源啊。

Answer 2

模块
Option ExplicitPublic Const MAX_PATH      As Long = 260
Public Const BIF_RETURNONLYFSDIRS   As Long = &H1
Public Const BIF_DONTGOBELOWDOMAIN  As Long = &H2
Public Const BIF_STATUSTEXT         As Long = &H4
Public Const BIF_RETURNFSANCESTORS  As Long = &H8
Public Const BIF_EDITBOX            As Long = &H16
Public Const BIF_VALIDATE           As Long = &H20
Public Const BIF_USENEWUI           As Long = &H40
Public Const BIF_NEWDIALOGSTYLE     As Long = &H64
Public Const BIF_BROWSEFORCOMPUTER  As Long = &H1000
Public Const BIF_BROWSEFORPRINTER   As Long = &H2000
Public Const BIF_BROWSEINCLUDEFILES As Long = &H16384
Public Const CSIDL_DESKTOP           As Long = &H0
Public Const CSIDL_INTERNET          As Long = &H1
Public Const CSIDL_PROGRAMS          As Long = &H2
Public Const CSIDL_CONTROLS          As Long = &H3
Public Const CSIDL_PRINTERS          As Long = &H4
Public Const CSIDL_PERSONAL          As Long = &H5
Public Const CSIDL_FAVORITES         As Long = &H6
Public Const CSIDL_STARTUP           As Long = &H7
Public Const CSIDL_RECENT            As Long = &H8
Public Const CSIDL_SENDTO            As Long = &H9
Public Const CSIDL_BITBUCKET         As Long = &HA
Public Const CSIDL_STARTMENU         As Long = &HB
Public Const CSIDL_DESKTOPDIRECTORY  As Long = &H10
Public Const CSIDL_DRIVES            As Long = &H11
Public Const CSIDL_NETWORK           As Long = &H12
Public Const CSIDL_NETHOOD           As Long = &H13
Public Const CSIDL_FONTS             As Long = &H14
Public Const CSIDL_TEMPLATES         As Long = &H15
Public Const CSIDL_COMMON_STARTMENU  As Long = &H16
Public Const CSIDL_COMMON_PROGRAMS   As Long = &H17
Public Const CSIDL_COMMON_STARTUP    As Long = &H18
Public Const CSIDL_COMMON_DESKTOPDIRECTORY As Long = &H19
Public Const CSIDL_APPDATA           As Long = &H1A
Public Const CSIDL_PRINTHOOD         As Long = &H1B
Public Const CSIDL_LOCAL_APPDATA     As Long = &H1C
Public Const CSIDL_ALTSTARTUP        As Long = &H1D
Public Const CSIDL_COMMON_ALTSTARTUP As Long = &H1E
Public Const CSIDL_COMMON_FAVORITES  As Long = &H1F
Public Const CSIDL_INTERNET_CACHE    As Long = &H20
Public Const CSIDL_COOKIES           As Long = &H21
Public Const CSIDL_HISTORY           As Long = &H22
Public Const CSIDL_COMMON_APPDATA    As Long = &H23
Public Const CSIDL_WINDOWS           As Long = &H24
Public Const CSIDL_SYSTEM            As Long = &H25
Public Const CSIDL_PROGRAM_FILES     As Long = &H26
Public Const CSIDL_MYPICTURES        As Long = &H27
Public Const CSIDL_PROFILE           As Long = &H28
Public Const CSIDL_PROGRAM_FILES_COMMON As Long = &H2B
Public Const CSIDL_COMMON_TEMPLATES  As Long = &H2D
Public Const CSIDL_COMMON_DOCUMENTS  As Long = &H2E
Public Const CSIDL_COMMON_ADMINTOOLS As Long = &H2F
Public Const CSIDL_ADMINTOOLS        As Long = &H30
Public Const CSIDL_FLAG_CREATE       As Long = &H8000&
Public Const CSIDL_FLAG_DONT_VERIFY  As Long = &H4000
Public Const CSIDL_FLAG_MASK         As Long = &HFF00
Private Type SHITEMID
 cb   As Long
 abID As Byte
End Type
Private Type ITEMIDLIST
 mkid As SHITEMID
End Type
Private 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 TypePublic Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End TypePrivate Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End TypePublic Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Public Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function SHBrowseForFolder Lib "Shell32" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHGetFolderPath Lib "Shell32" Alias "SHGetFolderPathA" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, ByVal dwReserved As Long, ByVal lpszPath As String) As Long
Public Declare Function SHGetFolderLocation Lib "Shell32" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, ByVal dwReserved As Long, pidl As ITEMIDLIST) As LongPublic Function BrForFolder(ByVal lngwHandle As Long, ByVal strTitle As String) As String
On Error Resume Next
    Dim BI    As BROWSEINFO
     Dim lPid  As Long
     Dim sPath As String
     Dim iPos  As Integer
     Dim lPidlRoot As ITEMIDLIST
     Call SHGetFolderLocation(lngwHandle, CSIDL_DESKTOP, 0&, 0&, lPidlRoot)
     With BI
        .hOwner = lngwHandle
       .pidlRoot = lPidlRoot.mkid.cb
       .pszDisplayName = Space$(MAX_PATH)
       .lpszTitle = strTitle
       .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE Or BIF_STATUSTEXT Or BIF_EDITBOX Or BIF_VALIDATE
     End With
     lPid = SHBrowseForFolder(BI)
     Dim flName As String
     If InStr(1, Trim(BI.pszDisplayName), "?") Then
        flName = ""
    Else
        If lPid <> 0 Then
          sPath = Space$(MAX_PATH)
          If SHGetPathFromIDList(ByVal lPid, ByVal sPath) Then
            iPos = InStr(sPath, Chr$(0))
            flName = Left$(sPath, iPos - 1)
            If Len(flName) = 3 Then
                flName = Left(flName, 2)
            End If
          End If
        Else
          flName = "\\" & Trim(BI.pszDisplayName)
          If flName = "\\" Then
             flName = ""
          End If
        End If
    End If
    BrForFolder = flName
    Call CoTaskMemFree(lPid)
End Function
窗体
Option ExplicitPrivate Sub Command1_Click()
    Dim fldName As String
    fldName = BrForFolder(Me.hWnd, "选择目录：")
        
    If fldName <> "" Then
        Text1.Text = fldName & "\"
    End If
End Sub