关闭文件Excel 2010 VBA时备份

Question

我希望Excel在没有提示给用户的情况下自动备份文件关闭的工作簿。我在网上找到了优秀的代码（忘记了源代码），但备份FileType正在更改为我无法打开的BAK文件。我该如何解决这个问题。这两个文件都在同一个文件夹中。备份应该具有相同的文件名和＆＃34; -bak＆＃34;或＆＃34; .bak＆＃34;。

Sub SaveWorkbookBackup()

Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean
   If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
   Set awb = ActiveWorkbook
   If awb.Path = "" Then
      Application.Dialogs(xlDialogSaveAs).Show
   Else
      BackupFileName = awb.FullName
      i = 0
      While InStr(i + 1, BackupFileName, ".") > 0
         i = InStr(i + 1, BackupFileName, ".")
    Wend
    If i > 0 Then BackupFileName = Left(BackupFileName, i - 1)
    BackupFileName = BackupFileName & ".bak"
    OK = False
    On Error GoTo NotAbleToSave
    With awb
        Application.StatusBar = "Saving this workbook..."
        .Save
        Application.StatusBar = "Saving this workbook backup..."
        .SaveCopyAs BackupFileName
        OK = True
    End With
  End If
NotAbleToSave:
   Set awb = Nothing
   Application.StatusBar = False
   If Not OK Then
    MsgBox "Backup Copy Not Saved!", vbExclamation, ThisWorkbook.Name
   End If
End Sub

Answer 1

编辑：这里是＆＃34; ThisWorkbook＆＃34;模块，您应该在此处添加此代码：

原始回复：将以下内容添加到＆＃34; ThisWorkbook＆＃34;模块：

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim awb As Workbook
Dim BackupFileName As String
Dim i As Long
Dim OK As Boolean
Dim SameFileFormat As XlFileFormat

If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
SameFileFormat = ThisWorkbook.FileFormat '<~ grab the file format
Set awb = ActiveWorkbook
If awb.Path = "" Then
    Application.Dialogs(xlDialogSaveAs).Show
Else
    BackupFileName = awb.FullName
    i = 0
    While InStr(i + 1, BackupFileName, ".") > 0
        i = InStr(i + 1, BackupFileName, ".")
    Wend
If i > 0 Then BackupFileName = Left(BackupFileName, i - 1)
BackupFileName = BackupFileName & "-bak" '<~ add "-bak" to the end of the filename
OK = False
On Error GoTo NotAbleToSave
With awb
    Application.StatusBar = "Saving the workbook backup"
    Application.DisplayAlerts = False
    .SaveAs Filename:=BackupFileName, FileFormat:=SameFileFormat '<~ save occurs here
    OK = True
    Application.DisplayAlerts = True
    Application.StatusBar = "Backup saved!"
    Application.StatusBar = False
End With

End If

NotAbleToSave:
   Set awb = Nothing
   Application.StatusBar = False
   If Not OK Then
    MsgBox "Backup Copy Not Saved!", vbExclamation, ThisWorkbook.Name
   End If

End Sub