保存時に同じブック名があれば日付を付加する

ユーザーフォーム講座 動画編 10回

動画でExcel　保存時に同じブック名があれば日付を付加する

保存時に同じブック名があれば日付を付加する

動画版「マクロ講座入門EX」10回の解説です。
新規ファイルを保存する時にもし同名ファイルがあると、メッセージが表示されて、アプリケーションディスプレイアラートが表示されます。
同じ名前のファイルがあります。置き換えますかとい内容の、警告メッセージが表示されます。
これは処理が止まってしまうと、いうことなので、何としても避けたい事態です。そこで、同名ファイルがある場合の処置を事前にVBAで考えていきます。
（サンプルファイルは、こちらです。 保存時に同じブック名があれば日付を付加する、サンプル10回）

マクロ動画　保存時に同じブック名があれば日付を付加する

ブック保存時に同名ブックがある場合の対応

通常では同名ファイルがある場合、置き換えますかと表示されます。

支店ごとの売上など、ブックを同名で通し番号や日付などをつけて保存していきたいケースがあります。
自動的にブック名の後ろに日付をつけて、さらに通し番号をつけてというような処理ができるようにVBAでコードを書いていきます。

新規ブック作成の名前を『保存名－日付-通し番号』のように命名します。
Len関数とDir（ディレクトリ関）数を使って、同じ名前が0になるまで保存名を変更しろというコードを書いています。

Len関数とDir関数については、 3回 フォルダ内のファイルをぜんぶ書き出すマクロにて詳しく解説しています。
ここでのLen関数は、(Dir(ThisWorkbook.Path & "\" & 保存名)) が返す値は0かファイル名なので、それを数えます。

さらに以下のコード部分で日付を保存名に追加して、通し番号をつけています。
保存名 = "Sample-" & Format(Date, "MMdd") & "-" & i & ".xlsx"
この操作をDo While　Loopの中に入れており、Dir関数は保存名と同じ名前がなくなれば、何も返さなくなるので、Lenは0となります。そうなったら、新規ブックを作成し、ブック名を『保存名－日付-通し番号』の形で保存します。

そうしたら、wb.SaveAs ThisWorkbook.Path & "\" & 保存名
で保存し、保存したブックは閉じます。
Application.ScreenUpdating = False
マクロ実行時に画面が更新されてちらつくのを防ぎたいとき、スピードをアップしたいときなどに、 今回の画面の更新を止めるために、”Application.ScreenUpdating=False”を使っています。

Application.DisplayAlerts = False　は、確認のメッセージを非表示にしたい時に、記述します。
自分で保存したのですから、確認のメッセージは不要ですよね。
コードを実行すると、以下のように元の保存名に日付と通し番号付きのファイルが保存されます。

Private Sub ブックを追加保存日付で区別()
    Dim wb As Workbook
    Dim 保存名 As String
    Dim i As Integer
    保存名 = "Sample.xlsx"
     i = 1
    
    Do While Len(Dir(ThisWorkbook.Path & "\" & 保存名)) <> 0
        保存名 = "Sample-" & Format(Date, "MMdd") & "-" & i & ".xlsx"
        i = i + 1
    Loop
    
    Application.ScreenUpdating = False
    Set wb = Workbooks.Add
    
    Application.DisplayAlerts = False
    wb.SaveAs ThisWorkbook.Path & "\" & 保存名
    Application.DisplayAlerts = True
    wb.Close
    Application.ScreenUpdating = True
End Sub

保存名を表示するメッセージを表示する

上記のコードでは、同じ名前があった場合に、 マクロの方で判断して保存名に日付と 通し番号を付与して、静かに保存して終わってしまいます。
しかし これではきちんと作業をしたのかどうか不安になってしまうかもしれません。
そこで メッセージボックスを表示させたいと思います。

MsgBoxを表示させるコード、
U MsgBox "ブックは「" & 保存名 & "」として保存されました。"
MsgBoxが嫌いなならば、イミディエイトウィンドーに表示するコードを使うと良いでしょう。
Debug.Print Now; 保存名

Private Sub SaveWorkbookメッセージ付き()
    Dim wb As Workbook
    Dim 保存名 As String
    Dim i As Integer
    
    保存名 = "Sample.xlsx"
    i = 1
    
    Do While Len(Dir(ThisWorkbook.Path & "\" & 保存名)) <> 0
        保存名 = "Sample-" & Format(Date, "MMdd") & "-" & i & ".xlsx"
        i = i + 1
    Loop
    Application.ScreenUpdating = False
    Set wb = Workbooks.Add
    
    Application.DisplayAlerts = False
    wb.SaveAs ThisWorkbook.Path & "\" & 保存名
    Application.DisplayAlerts = True
    wb.Close
    Application.ScreenUpdating = True
    MsgBox "ブックは「" & 保存名 & "」として保存されました。"
    Debug.Print Now; 保存名
End Sub