Excel VBA ファイルを保存する3つの方法と9つのひな形

ファイル/フォルダ操作

今回は、ファイルを保存する3つの方法を9つのひな形でご紹介します。

コードのひな形ですので、説明は極力省略します。

詳細については下記記事をご覧ください。

1.ファイルを上書きする方法

VBAの書かれたファイルを保存して閉じる

VBAが書かれている自身のファイルを上書き保存して閉じます。

Sub Sample1()

ThisWorkbook.Save

ThisWorkbook.Close

End Sub

開かれているファイルを指定し保存して閉じる

開かれていないとエラーになりますので注意が必要です。

Sub Sample2()

Workbooks("Test.xlsx").Save

Workbooks("Test.xlsx").Close

End Sub

新規ファイルを保存して閉じる

「Workbooks(“Book1”).Save」の部分に拡張子がありません。

一度も保存されていないファイルは拡張子がないため、新規ブックを初めて保存する場合には拡張子を指定しません。

Sub Sample3()

Workbooks.Add

Workbooks("Book1").Save

Workbooks("Book1.xlsx").Close

End Sub

2.名前を付けてファイルを保存する

もっともシンプルなSaveAsの保存方法

エラー処理など一切されていませんが、もっともシンプルな保存方法です。

Sub Sample4()

ThisWorkbook.SaveAs "C:\Sample\SampleFile.xlsm"

End Sub

確認メッセージを回避して保存する

同じ名前のファイルが存在した場合に「確認メッセージ」でVBAが停止する事を回避します。

Application.DisplayAlerts = Falseで確認メッセージを非表示にする

単純に確認メッセージを非表示しますが、確認なしに同一ファイル名に上書きしてします。

Sub Sample5()

Application.DisplayAlerts = False

ThisWorkbook.SaveAs "C:\Sample\SampleFile.xlsm"

Application.DisplayAlerts = True

End Sub
名前の存在を確認して保存する

保存するファイル名が同じフォルダに存在するか判定後に保存します。

Sub Sample3()

If Dir("C:\Sample\SampleFile.xlsm") <> "" Then

    MsgBox "同じファイル名があります。"
    Exit Sub
    
Else

    ThisWorkbook.SaveAs "C:\Sample\SampleFile.xlsm"
           
End If

End Sub
重複しないであろうファイル名で保存する

次のサンプルコードは日付と時間(秒)まで指定しています。

Sub Sample4()

    Dim Filename As String
    
    Filename = "C:\Sample\SampleFile" & Format(Now, "yyyymmdd_hhmmss") & ".xlsm"

    ThisWorkbook.SaveAs Filename

End Sub

SaveAsパラメーターを使用した保存する

FileFormat

保存するファイル形式を指定します。

Sub Sample5()

    Dim Filename    As String
    Dim WB          As Workbook
    
    Set WB = Workbooks.Add
    
    Filename = "C:\Sample\SampleFile" & Format(Now, "yyyymmdd_hhmmss")

    WB.SaveAs Filename, FileFormat:=xlWorkbookDefault

End Sub
Psaaword

次回開いたときにパスワードを求められます。

Sub Sample6()

    Dim Filename    As String
    Dim WB          As Workbook
    
    Set WB = Workbooks.Add
    
    Filename = "C:\Sample\SampleFile" & Format(Now, "yyyymmdd_hhmmss")

    WB.SaveAs Filename, Password:="0000"

End Sub
ReadOnlyRecommended

次回開いたときに読み取り専用メッセージが開きます。

Sub Sample7()

    Dim Filename    As String
    Dim WB          As Workbook
    
    Set WB = Workbooks.Add
    
    Filename = "C:\Sample\SampleFile" & Format(Now, "yyyymmdd_hhmmss")

    WB.SaveAs Filename, ReadOnlyRecommended:=True

End Sub

3.ダイアログで名前を付けて保存する

事前にカレントフォルダを指定する

保存したいフォルダに毎回移動する工数を省略できます。

次のコードをダイアログを開く前に追加します。

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

保存済みファイルをダイアログで名前を付けて保存する

保存済みファイルと明記したのは、新規ブックで「xlsm」などマクロのファイルを保存する際に注意が必要になるからです。

Sub Sample8()

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

新規ファイルを初めて保存する

新規ファイルでVBAを書いて、ダイアログボックスを開いて保存しようとする場合には、
ファイル名自体に拡張子を「xlsm」で保存しようとした場合に、次のような確認メッセージが発生します。

「Application.DisplayAlerts = False」でも回避できません。

そのため、次のように「xlsm」の場合の対応処理を組み込みます。

Sub Sample9()

    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

タイトルとURLをコピーしました