aaa.xlsというエクセルファイルを開いて

保存ボタンを押したとき、
別名のバックアップが取りたくて
下記のようなマクロを設定しています。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim FName As String

fol = "c:\作業中"
FName = fol & "\" & "bbb.xls"

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

End Sub


ただ、上記マクロだと保存ボタンを押した後に
ファイル自体がbbb.xlsとなってしまいます。

aaa.xlsのままで作業を継続したいのですが可能でしょうか?

※保存ボタンをおしたときにバックアップを作成するようなイメージです。
※aaa.xlsは毎回ファイル名、保存してある場所が変更されます。


どうぞよろしくお願いいたします。

回答の条件
  • 1人2回まで
  • 13歳以上
  • 登録:2011/02/22 22:59:56
  • 終了:2011/02/23 20:53:51

ベストアンサー

id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912011/02/23 01:20:03

ポイント1000pt

逆の発想ですが、保存してからコピーでどうでしょうか。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'// 一旦自分自身を保存
    Application.EnableEvents = False
    ThisWorkbook.Save
    Application.EnableEvents = True
    
'// バックファイルをコピー
    Const backupPath = "D:\Work\bbb.xls"
    
    With CreateObject("Scripting.FileSystemObject")
        .CopyFile ThisWorkbook.Path & "\" & ThisWorkbook.Name, backupPath, True
    End With
    Cancel = True
End Sub

蛇足ですが、

    Const backupPath = "D:\Work\bbb.xls"

の部分を下記のようにすれば、保存ごとに時間情報をファイル名にして保存していきます。

    Dim backupPath As String
    backupPath = "D:\Work\bbb_" & Application.Text(Now(), "YYYYMMDD_HHMMSS") & ".xls"

でも1世代前だけあればよいのであれば、不要ですね。

id:ohtsu6

ありがとうございます。

下記を利用させていただきます。

Dim backupPath As String

backupPath = "D:\Work\bbb_" & Application.Text(Now(), "YYYYMMDD_HHMMSS") & ".xls"

ちなみにですが、

Private Sub Workbook_BeforePrint(Cancel As Boolean)や

Private Sub Workbook_BeforeClose(Cancel As Boolean)では

実行できませんでした。

プリントのほうでも実行されるようにしたいのですが可能でしょうか?

どうぞよろしくお願いいたします。

2011/02/23 08:27:56

その他の回答(1件)

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982011/02/23 00:14:49

ポイント35pt

aaa.xlsをコピーして bbb.xlsにしてやればよい。

FileCopy ThisWorkbook.FullName, FName

といった感じで。

id:ohtsu6

ありがとうございます。

2011/02/23 08:23:39
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912011/02/23 01:20:03ここでベストアンサー

ポイント1000pt

逆の発想ですが、保存してからコピーでどうでしょうか。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'// 一旦自分自身を保存
    Application.EnableEvents = False
    ThisWorkbook.Save
    Application.EnableEvents = True
    
'// バックファイルをコピー
    Const backupPath = "D:\Work\bbb.xls"
    
    With CreateObject("Scripting.FileSystemObject")
        .CopyFile ThisWorkbook.Path & "\" & ThisWorkbook.Name, backupPath, True
    End With
    Cancel = True
End Sub

蛇足ですが、

    Const backupPath = "D:\Work\bbb.xls"

の部分を下記のようにすれば、保存ごとに時間情報をファイル名にして保存していきます。

    Dim backupPath As String
    backupPath = "D:\Work\bbb_" & Application.Text(Now(), "YYYYMMDD_HHMMSS") & ".xls"

でも1世代前だけあればよいのであれば、不要ですね。

id:ohtsu6

ありがとうございます。

下記を利用させていただきます。

Dim backupPath As String

backupPath = "D:\Work\bbb_" & Application.Text(Now(), "YYYYMMDD_HHMMSS") & ".xls"

ちなみにですが、

Private Sub Workbook_BeforePrint(Cancel As Boolean)や

Private Sub Workbook_BeforeClose(Cancel As Boolean)では

実行できませんでした。

プリントのほうでも実行されるようにしたいのですが可能でしょうか?

どうぞよろしくお願いいたします。

2011/02/23 08:27:56
  • id:Mook
    基本的に同じコードでできると思いますが、
    Close や Print では
      Cancel = True
    を外しておかないと処理自体が中断してしまいます。

    できないというのはバックアップファイル自体ができないということでしょうか。
  • id:Mook
    同じ処理をするのであれば、共通化した方が良いように思います。

    標準モジュールに下記を置き
    '------------------------------------------------
    Public Sub CopyBackupFile()
    '------------------------------------------------
      Const backupFolder = "C:\作業中"
    '// 一旦自分自身を保存
      Application.EnableEvents = False
      ThisWorkbook.Save
      
    '// バックファイルをコピー
      Dim backupPath As String
      backupPath = backupFolder & "\" & Replace(ThisWorkbook.Name, ".xls", "_" & Application.Text(Now(), "YYYY_HHMMDD") & ".xls")
      
      With CreateObject("Scripting.FileSystemObject")
        .CopyFile ThisWorkbook.Path & "\" & ThisWorkbook.Name, backupPath, True
      End With
      Application.EnableEvents = True
    End Sub
    '------------------------------------------------

    ThisWorkbook の下に下記を置いてどうでしょうか。
    '------------------------------------------------
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
      CopyBackupFile
    End Sub

    Private Sub Workbook_BeforePrint(Cancel As Boolean)
      CopyBackupFile
    End Sub

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
      CopyBackupFile
      Cancel = True
    End Sub
    '------------------------------------------------
    一応こちらでは動作確認済みです。
    保存ファイル名をオリジナルファイルを使用するように修正しましたが、
    固定ファイルがよければ回答のものをご使用下さい。
  • id:ohtsu6
    Mookさま

    どうもありがとうございました。

    思い通りのものができました。
  • id:Mook
    多くのポイント有難うございます。
    無事に動いたようで何よりでした。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません