2

我想要一个宏，它可以在保存文件时自动将我的文件备份到不同的文件夹。我找到了一个工作宏，但每次运行它时都会复制一份（在保存文件时不会自动生成）。谁能帮我修改宏代码以按照我的描述工作？

宏我有：

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
4

2 回答 2

6

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

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
于 2013-03-07T10:03:27.830 回答
4

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

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
于 2015-03-06T17:39:22.007 回答