Commondialog控件的另存为对话框可以指定文件夹而不是文件么？

Question

每次打开Commondialog控件的另存为对话框都是让我指定到文件，可是另存为时我是要指定一个文件夹，要怎么办？

Answer 1

Option ExplicitPrivate Sub Form_Load()
    With CommonDialog1
        .InitDir = "D:\"    '你要设置的路径
        .ShowSave
    End With
End Sub

Answer 2

我不是想设置初始路径，我是想让ShowSave得到的Filename是一个文件夹而不是文件，巫师能明白么

Answer 3

FileName本来就是文件名，而非路径名

Answer 4

可以用IFileDialog，需要Vista支持

Answer 5

用法: msgbox showdir("c:\")Option Explicit
'不支持win98
'增强版文件夹选择框
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_USER = &H400
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_INITIALIZED As Long = 1Public Declare Function SHBrowseForFolder Lib "Shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'很明显它需要一个 BROWSEINFO 结构的指针，如下：
Public Type BROWSEINFO
    hOwner As Long                 '注释：父窗口的句柄
    pidlRoot As Long               '注释：指向希望浏览的最上层的文件夹的标识符列表，可设为0
    pszDisplayName As String       '注释：返回你所选择的文件夹（带一个NULL字符）
    lpszTitle As String            '注释：对话框标题（要以vbNullChar结尾）
    ulFlags As Long                '注释：浏览标志（见下面）
    lpfn As Long                   '注释：回调函数的地址，可设为NULL
    lParam As Long                 '注释：若有回调函数，此项设置它的值
    iImage As Long                 '注释：保存所选文件夹映像索引的缓冲区
End TypePublic Const BIF_BROWSEFORCOMPUTER = &H1000             '注释：允许浏览计算机
Public Const BIF_BROWSEFORPRINTER = &H2000              '注释：允许浏览打印机文件夹
Public Const BIF_BROWSEINCLUDEFILES = &H4000            '注释：允许同时浏览文件（需IE4）
Public Const BIF_DONTGOBELOWDOMAIN = &H2                '注释：强制用户停留在网上邻居中
Public Const BIF_EDITBOX = &H10                         '注释：可在输入框中直接输入文件夹名（需IE4）
Public Const BIF_RETURNFSANCESTORS = &H8                '注释：返回文件系统祖先？
Public Const BIF_RETURNONLYFSDIRS = &H1                 '注释：仅允许浏览文件系统
Public Const BIF_STATUSTEXT = &H4                       '注释：显示状态栏
Public Const BIF_USENEWUI = &H40                        '注释：使用新界面（仅支持Win2000、WinME）
Public Const BIF_VALIDATE = &H20                        '注释：若输入一个非法文件夹名，就返回
                                                        'BFFM_VALIDATEFAILED 给回调函数
Public lastfolder As String
Dim nowdir As String
'有了这些还不够，因为 SHBrowseForFolder 返回的是文件夹的标识符列表（pidl），还需要用另一个函数将标识符列表转换成系统文件夹，这就是 SHGetPathFromIDList：
Public Declare Function SHGetPathFromIDList Lib "Shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
'Dim i As Integer
   '＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
   '下面我就来演示怎么将这些 API 放在一起，协同工作：
Public Function showdir(Optional defaultselectfolder As String, Optional editmode As Boolean, Optional issave As Boolean, Optional title As String = "选择文件夹", Optional hwnd As Long) As String
On Error Resume Next
If hwnd = 0 Then hwnd = Screen.ActiveForm.hwnd
'<start>弹出打开文件夹对话框
    Dim bi As BROWSEINFO
    Dim pidl As Long
    Dim folder As String
    Dim ret As Long
    nowdir = defaultselectfolder
If issave And (title = "选择文件夹" Or title = "") Then
title = "保存到目录："
Else
If title = "" Then title = "请选择一个文件夹"
End If
If nowdir = "" Then
nowdir = lastfolder
End If
  folder = String(255, vbNullChar)
   With bi
        .hOwner = hwnd
        If editmode Then '可新增
        .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_USENEWUI Or BIF_EDITBOX
        End If
        .pidlRoot = 0
        .lpszTitle = title
        .lpfn = MyAddressOf(AddressOf BrowseForFolders_CallbackProc)
    End With
    pidl = SHBrowseForFolder(bi)
    If SHGetPathFromIDList(ByVal pidl, ByVal folder) Then
        lastfolder = Left(folder, Len(nowdir))
        lastfolder = Left(folder, InStr(folder, vbNullChar) - 1)
        If Right(lastfolder, 1) <> "\" Then lastfolder = lastfolder & "\"
        showdir = lastfolder
    Else
        showdir = ""
    End If
End Function
Private Function BrowseForFolders_CallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
If uMsg = BFFM_INITIALIZED Then
  SendMessage hwnd, BFFM_SETSELECTIONA, True, ByVal nowdir
End If
End Function
Private Function MyAddressOf(AddressOfX As Long) As Long
MyAddressOf = AddressOfX
End Function