使用副本 after_save 创建文件备份,进入无限循环

Creating a backup of a file with copy after_save, goes into endless loop

我写了一个代码到运行当用户保存工作簿时,这段代码保存另一个副本,然后再次保存原始文件,以避免用户编辑"backup"工作簿。

再次保存原始文件后,触发 "after_save" 触发器,并一直保存到无穷大。

我在 Whosebug 上查看了解决方案,但没有找到。

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Call SaveToLocations
End Sub

Sub SaveToLocations()
    Dim WoExt, Ext, BkPath, nDateTime As String
    Static OrigName As String

    'defining variables
    nDateTime = Format(Now, "YYMMDD")
    OrigName = "C:\Users\xxx.xxx\Desktop\vbatest\test orig.xlsm"
    Ext = ".xls"
    WoExt = "test orig"
    BkPath = "C:\Users\xxx.xxx\Desktop\vbatest\Backup\"
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs (BkPath + WoExt + " - Backup - " + nDateTime + Ext)
    ActiveWorkbook.SaveAs OrigName
    Application.DisplayAlerts = True
End Sub

要创建存档,您需要在打开工作簿时保存工作簿,而不是在用户关闭它时保存在最后。下面的代码负责处理这个问题:

Private Sub Auto_Open()
 Dim WoExt, Ext, BkPath, nDateTime As String

 On Error GoTo ErrorHandler:

    'defining variables
    nDateTime = Format(Now, "YYMMDD")
    Ext = ".xls"
    WoExt = ThisWorkbook.Name
    BkPath = "C:\Users\xxx.xxx\Desktop\vbatest\Backup\"

        Application.DisplayAlerts = False
        ActiveWorkbook.SaveCopyAs (BkPath + WoExt + " - Backup - " + nDateTime + Ext)
        Application.DisplayAlerts = True


Exit Sub

ErrorHandler:
             MsgBox "Backup has not been saved."
End Sub

这只会保存备份,最后将编辑保存给用户。