Question

我想要一个宏，在保存文件时自动将我的文件备份到另一个文件夹。我找到了一个有效的宏，但每次运行它时都会复制（当文件被保存时不会自动生成）。任何人都可以帮我修改宏代码，就像我描述的那样工作吗？

MACRO我有：

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

您的意思是您只想要一个与原始名称相同的备份文件？只需从备份副本的文件名中删除日期和时间：

ActiveWorkbook.SaveCopyAs Filename:=backupfolder & ActiveWorkbook.Name

如果在尝试保存等时备份文件处于打开状态，您还应该添加某种错误处理。

编辑（根据新输入进行更新）

好的，那么你需要捕获一个事件。我已尝试使用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

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

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

保存文件时进行备份的宏

2 个答案: