ブックを新規作成し、同名ファイルを確認、名前を付けて上書き保存後閉じる：Excelでよく使うフレーズ

ブックの新規作成はAddメソッド、名前を付けて保存はSaveAsメソッド、閉じるにはCloseメソッドを使用します。

名前を付けて上書き保存するには、Application.DisplayAlerts = False を保存する前に実行すれば、警告メッセージを表示せずに保存できます。

同名ファイルの確認は以前掲載したTipsの、「ファイル・フォルダの存在確認」 を参照してください。

新規ブックを作成する

Addメソッドで新規ブックを作成するVBAです。


Sub MyNewBook()
    Workbooks.Add
End Sub

名前を付けて保存する

C2セルに保存する新規ファイル名を入力しておきます。


SaveAsメソッドで名前を付けて保存するVBAです。


・Filenameパラメーターでファイル名を指定します。

Sub MyNewBook()
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=Range("C2") & ".xlsx"
End Sub

実行結果です。
ブック名が表示されています。

同名ファイルを確認し、名前を付けて上書き保存する

C2セルに保存先のフォルダ名、C3セルにファイル名を入力しておきます。


ファイルの存在確認し保存するVBAです。


・ExDirプロシージャで同名ファイルの存在確認を行います。
・ExDirで空文字が返れば、存在しません
・同名ファイルが存在すれば、Application.DisplayAlerts = Falseで警告メッセージを表示しないようにし、SaveAsで保存します。

Private Function ExDir(sName As String, nAttr As Integer) As String
      If sName = "" Then
          ExDir = ""
          Exit Function
      End If
  On Error Resume Next
      Err.Number = 0
      ExDir = Dir(sName, nAttr)
      If Err.Number <> 0 Then
          ExDir = ""
      End If
  On Error GoTo 0
End Function
  
Sub MyNewBook()
    Dim sfina As String
    Dim twk As Workbook
    Dim lRet As Long
    
    Workbooks.Add
    
    sfina = Range("C2") & Range("C3") & ".xlsx"
    
    If ExDir(sfina, vbNormal) <> "" Then
        lRet = MsgBox("同名のファイルが存在します。" & vbCrLf & _
            "上書きしますか？", vbYesNo)
        If lRet = vbYes Then
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=sfina
        End If
    Else
        ActiveWorkbook.SaveAs Filename:=sfina
    End If
End Sub

実行結果です。
同名ファイルが存在する場合に表示したメッセージです。

ブックを閉じる

Closeメソッドでブックを閉じるVBAです。


Sub MyNewBook()
    Dim sfina As String
    Dim twk As Workbook
    Dim lRet As Long
    
    Workbooks.Add
    
    sfina = Range("C2") & Range("C3") & ".xlsx"
    
    If ExDir(sfina, vbNormal) <> "" Then
        lRet = MsgBox("同名のファイルが存在します。" & vbCrLf & _
            "上書きしますか？", vbYesNo)
        If lRet = vbYes Then
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=sfina
        Else
            Exit Sub
        End If
    Else
        ActiveWorkbook.SaveAs Filename:=sfina
    End If
    ActiveWorkbook.Close
End Sub