Backup When Closing File Excel 2010 VBA [duplicate]

Question

This question already has an answer here:

Backup on File Close Excel VBA (1 answer)

Closed 9 years ago.

I want Excel to automatically backup a workbook on file close without prompts to the user. I found the excellent code below online (forgot source) but the backup FileType is changing to a BAK File that I cannot open. How do I fix this problem. Both files will be in the same folder & the backup should have same file name & "-bak" or ".bak".

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

Edit: here is the "ThisWorkbook" module, which is where you should add this code:

Original response: Add the following into the "ThisWorkbook" module:

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