macros保存文件时进行备份

我想有一个macros，它会自动将我的文件的备份保存到不同的文件夹。 我已经find了一个工作macros，但每次运行时都会生成一个副本（当文件正在保存时不会自动生成）。 任何人都可以帮助我修改macros代码工作，我所描述的？

macros我有：

Sub Auto_Save() Dim savedate savedate = Date Dim savetime savetime = Time Dim formattime As String formattime = Format(savetime, "hh.MM.ss") Dim formatdate As String formatdate = Format(savedate, "DD - MM - YYYY") Application.DisplayAlerts = False Dim backupfolder As String backupfolder = "Z:\My Documents\" ActiveWorkbook.SaveCopyAs Filename:=backupfolder & formatdate & " " & formattime & " " & ActiveWorkbook.Name ActiveWorkbook.Save Application.DisplayAlerts = True MsgBox "Backup Run. Please Check at: " & backupfolder & " !" End Sub 

Answer 1

你的意思是你只想要一个与原来的同名的备份文件？ 只需从备份副本的文件名中删除date和时间即可：

 ActiveWorkbook.SaveCopyAs Filename:=backupfolder & ActiveWorkbook.Name 

如果备份文件在尝试保存时打开，您还应该添加某种error handling。

编辑 （根据新的input更新）

好的，那么你需要捕捉一个事件。 我已经尝试过BeforeSave事件，它的工作原理。 还有一个AfterSave事件，你可以尝试。

将以下内容添加到ThisWorkbook模块：

 Option Explicit Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim backupfolder As String backupfolder = "Z:\My Documents\" ThisWorkbook.SaveCopyAs Filename:=backupfolder & ThisWorkbook.Name End Sub 

Answer 2

这是我创build的备份我的工作簿的代码。 如果备份不存在，它将为您的备份创build一个子目录，并将备份保存到该目录。

 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Application.EnableEvents = False thisPath = ThisWorkbook.Path myName = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".") - 1)) ext = Right(ThisWorkbook.Name, Len(ThisWorkbook.Name) - InStrRev(ThisWorkbook.Name, ".")) backupdirectory = myName & " backups" Set FSO = CreateObject("Scripting.FileSystemObject") If Not FSO.FolderExists(ThisWorkbook.Path & "/" & backupdirectory) Then FSO.CreateFolder (ThisWorkbook.Path & "/" & backupdirectory) End If T = Format(Now, "mmm dd yyyy hh mm ss") ThisWorkbook.SaveCopyAs thisPath & "\" & backupdirectory & "\" & myName & " " & T & "." & ext Application.EnableEvents = True End Sub