Excel VBA ダイアログボックスでファイルを名前を付けて保存する

今回はダイアログボックスを開いて、別ファイルとして名前をつけて保存する方法をご説明します。

別記事で紹介している上書き保存、名前を付けて保存は予め指定されているファイル名で保存する方法ですが、今回はユーザーに保存場所とファイル名を指定してもらい保存します。

ユーザーに任意に保存してもらう場合などに非常に便利です。

その他のファイルの保存方法については、次の記事をご覧ください。

1.名前を付けて保存するダイアログを開く
3.ダイアログを開いて名前を付けて保存
4.新規ファイルを初めて保存する場合の注意

1.名前を付けて保存するダイアログを開く

ダイアログボックスを開く

名前を付けて保存するダイアログボックスを開くにはApplicationオブジェクトの「GetSaveAsFilename」メソッドを使用します。

構文は次のようになっています。

Application.GetSaveAsFilename(InitialFilename, FileFilter, FilterIndex, Title, ButtonText)

引数一覧

引数	説明
InitialFilename	既定値として表示するファイル名を指定します。省略すると、作業中のブックの名前が使われます。
FileFilter	ファイルの種類を指定する文字列を指定します。
FilterIndex	「FileFilter」で指定したファイルフィルター文字列の中で、1から何番目の値を既定値とするかを指定します。省略するか、ファイルフィルター文字列より大きい数値を指定すると、最初のファイルフィルター文字列が既定値となります。
Title	ダイアログボックスのタイトルを指定します。
ButtonText	Macintoshでのみ指定できます。

ダイアログボックスで指定されたフォルダとファイル名を取得

シンプルに書くと次のようなコードになります。

次のコードは「FileName」変数に「Application.GetSaveAsFilename」で指定されたフォルダパスとファイル名を格納します。

この時点ではまだ保存できていません。

Sub Sample1()

Dim FileName As String

FileName = Application.GetSaveAsFilename

MsgBox FileName

End Sub

ダイアログボックスのキャンセル処理

ダイアログボックスを開いて、フォルダとファイル名を取得出来ましたが、キャンセルや「×」ボタンで閉じられると戻り値は「False」を返します。

このまま保存の処理が進むとエラーとなるため、キャンセルされた場合の処理を組み込みます。

次のコードは代入された変数が「False」ではない場合のみ実行されます。

Sub Sample2()

Dim FileName As String

FileName = Application.GetSaveAsFilename

If FileName <> "False" Then

    MsgBox FileName
    
End If

End Sub

予め表示するフォルダを指定する

もしダイアログを開いて保存する際に、フォルダが決まっている場合は予め指定していた方が、毎回そのフォルダに移動するわずらわしさがなくなります。

フォルダを指定するには「CreateObject(“WScript.Shell”)」で指定します。

本来カレントフォルダの指定は「ChDirプロパティ」を使用しますが、共有ネットワーク上のフォルダに対応できるように「CreateObject(“WScript.Shell”)」を使用しています。

Sub Sample3()

With CreateObject("WScript.Shell")
    
    .CurrentDirectory = "C:\Sample\"
    
End With

End Sub

3.ダイアログを開いて名前を付けて保存

ダイアログボックスを開いて、指定されたフォルダとファイル名を取得出来ましたので、取得した結果を使用してファイルを保存します。

保存するには「SaveAs」を使用します。

「SaveAs」の使用方法については「SaveAsメソッドで名前を付けてファイルを保存する」をご覧ください。

また、「FileFilter:=”Excelブック,.xlsx,Excelマクロ,.xlsm,テキスト,*.txt”」は保存時に拡張子を選択しやすくなるため、可能であれば事前に設定しておくことをお勧めします。

Sub Sample4()

Dim FileName As String

FileName = Application.GetSaveAsFilename _
        (FileFilter:="Excelブック,*.xlsx,Excelマクロ,*.xlsm,テキスト,*.txt")

If FileName <> "False" Then

    ActiveWorkbook.SaveAs FileName:=FileName
    
End If

End Sub

4.新規ファイルを初めて保存する場合の注意

非常に稀なケースではあるかと思いますが、新規ファイルでVBAを書いて、ダイアログボックスを開いて保存しようとする場合には注意が必要です。

ファイル名自体に拡張子を「xlsm」で保存しようとした場合に、次のような確認メッセージが発生します。

ここで「はい」を選択すると、せっかく書いたコードが消えます。

xlsmで保存する場合は一度自身で拡張子を指定してから保存する事をお勧めします。

上記の現象を回避するためには次のように対応します。

選択されたファイル名に「.xlsm」が含まれているか判定して、含まれている場合のみ別途処理します。

他の拡張子で同様のエラーが発生する場合は、便宜分岐させて回避が必要です。

Sub Sample5()

    Dim Filename    As String
    Dim WB          As Workbook
    
    Set WB = Workbooks.Add
    
    Filename = Application.GetSaveAsFilename _
        (FileFilter:="Excelブック,*.xlsx,Excelマクロ,*.xlsm,テキスト,*.txt")

    If Filename <> "False" Then
    
        If InStr(Filename, ".xlsm") <> 0 Then
    
            WB.SaveAs Filename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            
        Else
        
            WB.SaveAs Filename
        
        End If
        
    End If

End Sub