【VBA】同名ファイルへの上書き確認／名前を付けて保存等の処理を行う

こんにちは、Ryoです。
保存処理時に同名ファイルが存在する場合、Application.DisplayAlerts = False を使用して警告メッセージ無効にしていると気付かない間に誤って上書き保存してしまうミス等が稀にあります。先日私自身が手痛い失敗したこともあり、同名ファイルが存在する場合の上書き確認や名前を付けて保存を行う処理等の一連の流れについて書いていきたいと思います。

1.サンプル概要
2.サンプルコード
3.まとめ

1.サンプル概要

デスクトップ上に「Sampleフォルダ」を作成し、その中に「Sample1.xlsm」「Sample2.xlsm」の2ファイルが保存してあります。この内Sample1.xlsmはサンプルコードを記述している実行ファイルになります。

Sample2.xlsmはSample1ファイルを複製して名前だけを変えたものになります。

Sample1ファイルを開いてサンプルコードを実行すると、Sampleフォルダに「Sample2.xlsm」として保存する処理を最初に行いますが、このフォルダ内には既に同名ファイルが存在するので、以下のアラートが表示されます。

ここで「はい(Y)」をクリックすれば上書き保存、メッセージ表示にて処理を終了します。

「いいえ(N)」または「キャンセル」をクリックした場合はOn Error Goto処理で指定したラベルに処理を移行させ、そこで「名前を付けて保存」のダイアログを表示させます。

ダイアログの保存既定パスは上述のSampleフォルダを表示させるように予め設定、ファイル名やファイルの種類についても同様に設定しています。

「保存」をクリックすると指定したファイル名で保存、メッセージ表示を行って処理を終了します。

「キャンセル」をクリックした場合は保存処理は実行せず、メッセージで保存せずに終了する旨を表示して処理を終わらせています。

以上がサンプル概要になります。

2.サンプルコード

Sub Sample1()
 
  '次行でエラーが発生した場合、「Label1」に移行
  On Error GoTo Label1

  '指定した保存先に同名ファイルが存在する為、
  '上書きについて警告が表示される
  ThisWorkbook.SaveAs Filename:= _
  ThisWorkbook.Path & "\Sample2.xlsm"
  '上書き＝「はい(Y)」を選択した場合、ラベルに移行せず
  'メッセージ表示⇒Exit Subにて終了
  MsgBox "保存完了しました", vbInformation
  Exit Sub
 
Label1:  '「いいえ(N)」または「キャンセル」を選択

  '上書きを回避する上で「名前を付けて保存」のダイアログを表示し、
  '保存既定パスを予め設定しておく
  Const fPath As String = _
  "D:\デスクトップ\Sampleフォルダ\"
  ChDrive fPath
  ChDir fPath

  '「名前を付けて保存」ダイアログ表示の際にファイル名と
  'ファイルの種類を設定する
  Filename = Application.GetSaveAsFilename _
  (InitialFileName:="コピー" & "_Sample2.xlsm", _
  FileFilter:="Excelファイル,*.xlsm")

  'ダイアログで「キャンセル」が押された場合は
  '保存処理を実行せずに終了させる
  If Filename = False Then
        MsgBox "保存せずに終了します", vbCritical
        Exit Sub
    Else
       '「保存」がクリックされたら指定したファイル名で
       '保存処理を実行する
       ActiveWorkbook.SaveAs Filename
  End If

  '保存処理完了後、メッセージ表示を実行し終了
  MsgBox "保存作業完了しました", vbInformation

End Sub

コード最初に保存処理を行うので、その際のエラー判定としてOn Error Gotoを使用しています。ここでエラーとなるのは上書き保存を問われた際の「いいえ(N)」「キャンセル」が該当になります。

「はい(Y)」であれば上書き保存⇒終了ですが、上述のエラー判定はLabel1に処理が移行します。ここでは名前を付けて保存のダイアログを表示させますが、保存先として表示したい場所を定数設定（Const）し、ChDrive／ChDirステートメントで変更しています。

また、手間を省く上で「名前を付けて保存」のダイアログに予めファイル名とファイルの種類をApplication.GetSaveAsFilename メソッドで設定しておきますが、この時にファイル名で指定する拡張子とFileFilterで設定する拡張子を整合させておかないと表示されないので注意が必要です。

Filename = Application.GetSaveAsFilename _
(InitialFileName:=”コピー” & “_Sample2.xlsm“, _
FileFilter:=”Excelファイル,*.xlsm“)

後はダイアログ表示の際の処理になります。「保存」クリックで指定した名前で保存され、「キャンセル」ボタンクリックで保存せずに終了させています。キャンセルボタン＝Falseなので、以下のように判定させることができます。

If Filename = False Then

これで「上書き可否確認」⇒「名前を付けて保存可否確認」という形になりますので、注意を要する保存処理を行う際には確認しながら処理を行える形になります。

処理の流れを簡易的に表すと下の画像のようになっていますので、ご参考までに。