ファイルを保存する ダイアログを表示方法は基本的にファイルを開くダイアログと同じ。違うのは、OPENFILENAME 構造体のメンバ flag に指定する定数とAPI関数の宣言である。API関数は以下の通り。

Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (ByRef pOpenfilename As OPENFILENAME) As Long

例によって、プレビュー付きもある。

Private Declare Function GetSaveFileNamePreview Lib "msvfw32.dll" Alias "GetSaveFileNamePreviewA" (ByRef pOpenfilename As OPENFILENAME) As Long

で、関数。

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：ファイルを保存するためのダイアログボックスを表示し、ファイル名、または
'         ファイルのフルパスを返す
' 引  数：(i) hWnd     … 呼び出す側のウインドウハンドル
'         (i) RetMode  … 0：ファイルのフルパスを返す
'                         1：ファイル名を返す
'         (i) Filter   … 拡張子設定のフィルタ  (省略可能)
'         (i) InitialDir  … ディレクトリ指定  (省略可能)
'         (i) DialogTitle … ダイアログボックスのタイトル  (省略可能)
' 返り値：ファイル名、またはファイルのフルパス  キャンセル：空文字
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function GetSaveFilePath(ByVal hwnd As Long, _
                      ByVal RetMode As Integer, _
                      Optional ByVal Filter As String = "すべてのファイル (*.*)" & vbNullChar & "*.*" & vbNullChar, _
                      Optional ByVal InitialDir As String = "", _
                      Optional ByVal DialogTitle As String = "ファイルを名前を付けて保存する") As String

    Dim udtOpenFile As OPENFILENAME
    Dim FuncRet As Long

    With udtOpenFile
        .lStructSize = Len(udtOpenFile)   '構造体のサイズ
        .hWndOwner = hwnd                 'オーナーハンドルを指定
        .hInstance = App.hInstance        'インスタンス指定
        .flags = OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY Or _
                 OFN_OVERWRITEPROMPT      'フラグを指定する
        .lpstrFile = String$(MAX_PATH, Chr$(0))       'ファイル名を格納するバッファを設定
        .nMaxFile = MAX_PATH                          'ファイル名を格納するバッファサイズ
        .lpstrFileTitle = String$(MAX_PATH, Chr$(0))  'ファイルのフルパスを格納するバッファ
        .nMaxFileTitle = MAX_PATH                     ' ファイルのフルパスを格納するバッファサイズ
        .lpstrInitialDir = InitialDir                 '初期ディレクトリ指定
        .lpstrFilter = Filter                         'フィルターの設定
        .nFilterIndex = 1                             'フィルターインデックスを指定
        .lpstrTitle = DialogTitle                     'ダイアログボックスの名前を指定
    End With

    FuncRet = GetSaveFileName(udtOpenFile)

    If FuncRet <> 0 Then
        Select Case RetMode
            Case 0      'ファイルのフルパスを返す
                GetSaveFilePath = Left$(udtOpenFile.lpstrFile, InStr(udtOpenFile.lpstrFile, Chr$(0)) - 1)
            Case Else    'ファイル名を返す
                GetSaveFilePath = Left$(udtOpenFile.lpstrFileTitle, InStr(udtOpenFile.lpstrFileTitle, Chr$(0)) - 1)
        End Select
    Else
        GetSaveFilePath = ""
    End If

End Function