マクロ 日時の付いたファイルを自動でバックアップ

質問

久しぶりに、お世話になります。
下記のような記述をネット検索で見つけ引用して、Excelのファイルを開いた時に
自動でバックアップファイルを作成するようにしているのですが、ファイル名の前に月日時分の付いたバックアップファイルにしたいと思って、検索しましたが、検索方法が悪いのか、中々発見できず困っております。
どなたか詳しい方がいらっしゃいましたら、恐縮ですが、記述をご伝授ねがえないでしょうか。
よろしくお願い致します。

以下を「Ｔｈｉｓｗｏｏｋｂｏｏｋ」、モジュール「open」に以下をコピペして活用しております。

Private Sub Workbook_Open()
Dim FName As String
FName = ThisWorkbook.FullName
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FName, CreateBackup:=True
Application.DisplayAlerts = True
End Sub

回答No.4

WindFaller · ベストアンサー

こんにちは。

開く時に使うわけですよね。
以下のコードは、開きながら、VBA外部で仕事をするので、すぐに開くはずです。
ファイルが大きい場合は、VBA自体のメソッドを使うと、時間が掛かることがあります。
これは、私がいつも使っているものを書き換えたものです。

'//
Private Sub Workbook_Open()
　Dim objFso As Object
　Dim mDate As String
　Dim mPath As String
　Dim Fn As String
　mDate = Format$(Now(), "yyMMddhhnn") '年号は2桁にする/不要ならyyを取る
　mPath = ThisWorkbook.Path
　Fn = ThisWorkbook.Name
　If Not Fn Like String(10, "#") & "*" Then '10桁をチェック/yyを取ったら8にする
　　'月日時分が先頭にある、バックアップは取らない
　　'=バックアップファイルからは、孫ファイルは作らない
　　'ただし、バックアップ名が同じであっても上書きする
　　Set objFso = CreateObject("Scripting.FilesystemObject")
　　objFso.Copyfile mPath & "\" & Fn, mPath & "\" & mDate & Fn
　　Set objFso = Nothing
　End If
End Sub

お礼

早速のご回答ありがとうございました。
何と、動きの早いこと！
それに、孫ファイルが出来ないとは、素晴らしい！！
孫もひ孫も・・・出来るものと決めていて、思いも寄りませんでした。
思っていた以上のご回答ありがとうございました。

回答No.3

keithin

＞バックアップファイルにしたい

マクロの使い方が間違っています。
「CreateBackup:=True」はバックアップとして保存する指定ではありません。

作成例：
private sub workbook_Open()
　dim myFile as string
　myfile = thisworkbook.name

　if isnumeric(left(myfile, 14)) then
　myfile = mid(myfile, 15, 99)
　end if

　thisworkbook.savecopyas thisworkbook.path & "\" & format(now, "yyyymmddhhmmss") & myfile
end sub

お礼

早速のご回答ありがとうございました。
試してみまして、思った通りの結果がでました。
その上、アドバイスも頂きありがとうございます。
お見事でした。
お忙しいところ、本当にありがとう御座いました。

補足

補足の欄で申し訳ありませんが、この夏頃は、度々お世話になりありがとうございました。
今回も、またご回答いただきありがとうございました。

回答No.2

K Kazz（@JazzCorp）

FNameに付加するだけ？
FName = ThisWorkbook.Path & "\" & Format(Now, "mmddhhmm") & ThisWorkbook.Name

お礼

早速のご回答ありがとう御座いました。
何とシンプルかつ、的確なご回答！！関心いたしました。
希望通りの結果が出まして、感激しております。
それにしても、色々な手法があるものと感心しております。
孫ファイルやひ孫ファイルが必要な時も有ります。
本当に、ありがとうございました。

回答No.1

webnas

もしかしてこういうことでしょうか？
元のファイル名が数値１２桁だと使えませんが・・

Private Sub Workbook_Open()
Dim FName As String

If IsNumeric(Left(ThisWorkbook.Name, 12)) Then
FName = ThisWorkbook.Path & "\" & Format(Now, "yymmddhhmmss") & Mid(ThisWorkbook.Name, 13, Len(ThisWorkbook.Name) - 12)
Else
FName = ThisWorkbook.Path & "\" & Format(Now, "yymmddhhmmss") & ThisWorkbook.Name
End If

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FName, CreateBackup:=True
Application.DisplayAlerts = True
End Sub

お礼

早速のご回答ありがとうございました。
お礼、遅くなり申し訳ありません。
一番に回答頂き、ありがとうございます。
急きょの出張で遅くなりましたが、早速、試してみまして、
思った通りの結果となりまして、感激しております。
申し分御座いません。
ありがとうございました。