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

Question

ohtsu6

50

50もっと見る

1035pt

コンピュータ

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回まで

登録：2011/02/22 22:59:56
終了：2011/02/23 20:53:51

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

No.1

きゃづみぃ1353911982011/02/23 00:14:49

35pt

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

FileCopy ThisWorkbook.FullName, FName

といった感じで。

ありがとうございます。

2011/02/23 08:23:39

Mook 2011/02/23 09:32:52

基本的に同じコードでできると思いますが、
Close や Print では
　　Cancel = True
を外しておかないと処理自体が中断してしまいます。

できないというのはバックアップファイル自体ができないということでしょうか。
Mook 2011/02/23 10:47:07

同じ処理をするのであれば、共通化した方が良いように思います。

標準モジュールに下記を置き
'------------------------------------------------
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
'------------------------------------------------
一応こちらでは動作確認済みです。
保存ファイル名をオリジナルファイルを使用するように修正しましたが、
固定ファイルがよければ回答のものをご使用下さい。
ohtsu6 2011/02/23 20:53:00

Mookさま

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

思い通りのものができました。
Mook 2011/02/23 22:32:35

多くのポイント有難うございます。
無事に動いたようで何よりでした。

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

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

リクエスト送信済

回答リクエストを送信したユーザーはいません

Mook · Accepted Answer · 2011-02-23T01:20:03+09:00

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

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世代前だけあればよいのであれば、不要ですね。

Mook · Accepted Answer · 2011-02-23T01:20:03+09:00

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

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世代前だけあればよいのであれば、不要ですね。

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

ベストアンサー

Mook13143932011/02/23 01:20:03

その他の回答（1件）

きゃづみぃ1353911982011/02/23 00:14:49

Mook13143932011/02/23 01:20:03ここでベストアンサー

コメント（4件)

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