使用副本 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
这只会保存备份,最后将编辑保存给用户。
我写了一个代码到运行当用户保存工作簿时,这段代码保存另一个副本,然后再次保存原始文件,以避免用户编辑"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
这只会保存备份,最后将编辑保存给用户。