代码一：
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Dim mypath As String, fname As String
fname = Format(Date, "yymmdd") & ThisWorkbook.Name
mypath = ThisWorkbook.Path & "/备份/"
ThisWorkbook.SaveCopyAs mypath & fname
End Sub
代码二：
Private Sub Workbook_Open()
Dim OldName As String
OldName = ThisWorkbook.FullName
Dim DateTime As String
DateTime = Format(Now(), "YYYYMMDDhhmm")
Dim NewName As String
Dim FileName As String
FileName = Split(ThisWorkbook.Name, ".")(0)
NewName = ThisWorkbook.Path & "\Archive" & FileName & "-" & DateTime & ".xlsx"
Dim cmdline As String
cmdline = "copy """ & OldName & """ """ & NewName & """"
Shell "cmd.exe /c" & cmdline, vbMinimizedNoFocus
End Sub
