Backup Save in Addition to Regular Save

[Vonsteiner]

Greetings Everyone,

I hope everyone is well. I have userform code in place to save a file based on a cell value and to also save a backup file with the date added. Both of these work for the most part. Here is the code as I have it right now:

Dim wb As Workbook
Dim wbname As String

Set wb = ActiveWorkbook

wbname = ThisWorkbook.Path & "\" & _
    ThisWorkbook.Worksheets("Case Information").Range("A1").Value & " MTO "
    
wb.SaveAs wbname

Call BackupWorkbook

Backup Code

Dim wb2 As Workbook
Dim wbname2 As String


Set wb2 = ActiveWorkbook


wbname2 = ThisWorkbook.Path & "\Backups\" & _
    ThisWorkbook.Worksheets("Case Information").Range("A1").Value & " MTO " & _
    Format(Now(), "dd-mm-yyyy")
    
wb2.SaveAs wbname2

With the code in this order is saves both of the files in the correct place, but the backup file now has become the active workbook. If I reverse the code and have Excel save the backup first it saves both files in the Backups folder, but it does make my non-backup the active file. Is there a way to have Excel save both files correctly, but then have the non-backup file be the active workbook? Also, I have the code save the workbook after each userform using the wb.save command. Right now it would just save the non-backup. How would I include the backup being saved as well.

Michael

 

[dmt32]

Hi,
Use SaveCopyAs to make backups of your workbook
[FONT=&quot]This method saves a copy of your workbook to a file but doesn't modify the open workbook in memory.

Untested but you could modify your code as follows

[/FONT]

Dim wb As Workbook
Dim wbname As String


Set wb = ActiveWorkbook


wbname = ThisWorkbook.Path & "\" & _
    ThisWorkbook.Worksheets("Case Information").Range("A1").Value & " MTO "
    
wb.SaveAs wbname

'pass workbook object & file path to backup code
Call BackupWorkbook(wb, wbname)
[FONT=&quot]

'make backup copy

[/FONT]

Sub BackupWorkbook(ByVal wb As Object, ByVal BackupFilePath As String)
    wb.SaveCopyAs BackupFilePath & " " & Format(Now(), "dd-mm-yyyy")
End Sub
[FONT=&quot]

Dave[/FONT]

 

[Vonsteiner]

The backup wasn't saving in the correct folder or as an Excel file. So I tweaked my original code and it works perfectly now. The 'SaveCopyAs' was the exact code I needed, Thank you Dave. I went with this to save the original and a backup:

Dim wb As Workbook
Dim wb2 As Workbook
Dim wbname As String
Dim wbname2 As String


Set wb = ActiveWorkbook
Set wb2 = ActiveWorkbook

'save file
wbname = ThisWorkbook.Path & "\" & _
    ThisWorkbook.Worksheets("Case Information").Range("A1").Value & " MTO" & ".xlsm"
    
wb.SaveAs wbname
    
'save a backup


wbname2 = ThisWorkbook.Path & "\Backups\" & _
   ThisWorkbook.Worksheets("Case Information").Range("A1").Value & " MTO " & _
    Format(Now(), "dd-mm-yyyy") & ".xlsm"


wb2.SaveCopyAs wbname2

Michael