Make a backup to active workbook

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Make a backup to active workbook

Post by gailb »

I'd like to make a backup to the currently active workbook. The workbook is a .xlsm and I want to save as a .xlsx.

This code below works, but it closes out the original active workbook. I'd like to keep the original active workbook open so I can do some further VBA code processing.

Code: Select all

Sub SaveAsBackup()

    Dim FName   As String: FName = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))
    Dim FPath   As String: FPath = ActiveWorkbook.Path & Application.PathSeparator
    Dim strDate As String: strDate = Format(Now, "mmm-yyyy")
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=FPath & FName & " - " & strDate & ".xlsx", FileFormat:=51
    Application.DisplayAlerts = True
    
End Sub

User avatar
HansV
Administrator
Posts: 78237
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Make a backup to active workbook

Post by HansV »

You have to use a trick for this: use SaveCopyAs to save a copy of the workbook (which must be the same type, so .xlsm).
Then open the copy, save that as .xlsx, and finally delete the .xlsm copy.

Code: Select all

Sub SaveAsBackup()
    Dim FName     As String: FName = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".") - 1))
    Dim FPath     As String: FPath = ActiveWorkbook.Path & Application.PathSeparator
    Dim strDate   As String: strDate = Format(Now, "mmm-yyyy")
    Dim FNewName1 As String: FNewName1 = FPath & FName & " - " & strDate & ".xlsm"
    Dim FNewName2 As String: FNewName2 = FPath & FName & " - " & strDate & ".xlsx"
    Dim wbkNew    As Workbook
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ThisWorkbook.SaveCopyAs Filename:=FNewName1
    Set wbkNew = Workbooks.Open(Filename:=FNewName1)
    wbkNew.SaveAs Filename:=FNewName2, FileFormat:=xlOpenXMLWorkbook
    wbkNew.Close SaveChanges:=False
    Kill FNewName1
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: Make a backup to active workbook

Post by gailb »

Thanks Hans. This worked great.