代碼一：

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