VBA Code to SaveAs file in one location, and backup to another location

[honger]

Hello,

I have a code where when user selects SaveAs, it will automatically direct the user to the intended path and intended filename populated in saveas dialog box.

How do I save a copy to another location using the same function? So it will have 2 copies living in 2 separate directories?

I am assuming i have to run SaveAs and Save simultaneously but cant figure this out to save my life so some help would be greatly appreciated.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim vFilename As Variant
Dim vPath As Variant

'Disable events so "new save" doesn't re-trigger this event
Application.EnableEvents = False

If SaveAsUI = True Then ' User selected SaveAs instead of Save

    Cancel = True ' Cancel the user's original save action
    
        'This will make this shared before saving.
        If Not ActiveWorkbook.MultiUserEditing Then
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs ActiveWorkbook.Name, accessmode:=xlShared
        Application.DisplayAlerts = True
      
    End If
    
    Application.DisplayAlerts = False
    
    vPath1 = "\\tarcds01\eCTD_Submission\TRACKERS\" & Sheet1.Range("Q1").Value & "\" & Sheet1.Range("R1").Value & "\"
    vPath2 = Sheet1.Range("Q1").Value & "-" & Sheet1.Range("R1").Value & "-" & Sheet1.Range("S1").Value
 
    'Simulate built in "SaveAs", Use desired "IntialFilename" & filter
    vFilename = Application.GetSaveAsFilename(InitialFileName:=vPath1 & vPath2, fileFilter:="Regeneron Excel Macro-Enabled Worksheet (*.xlsm), *.xlsm")
    
    If vFilename <> False Then

        'Save file with desired parameters
        ThisWorkbook.SaveAs Filename:=vFilename, FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Use desired FileFormat
        
    End If
    
    Debug.Print vFilename
    
    Application.DisplayAlerts = True
    
End If

[mikeTRON]

Will the workbook name change?

either way you can save AS to the backup location THEN save as to the location they choose for you.

[mikeTRON]

ActiveWorkbook.SaveCopyAs Filename:= filePath & ActiveWorkbook.Name assuming filePath is the file path you want to use.

[honger]

Thanks for ur reply. The filename stays the same....so where would i put the code you suggested? As another private sub function? Or does it go in current private sub.

[mikeTRON]

So there are a few constraints apparently. It can only be saved as an xlsx file so this won't work for you BUT try the following shown in blue.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim vFilename As Variant
Dim vPath As Variant
Dim vBackupPath as string

'Declare filepath
vBackupPath = "C:\BACKUP\ 'this has to have the "\" at the end
'You could also use a cell in the spreadsheet to house this if that is easier to audit

'Disable events so "new save" doesn't re-trigger this event
Application.EnableEvents = False

If SaveAsUI = True Then ' User selected SaveAs instead of Save

    Cancel = True ' Cancel the user's original save action
    
        'This will make this shared before saving.
        If Not ActiveWorkbook.MultiUserEditing Then
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs ActiveWorkbook.Name, accessmode:=xlShared
        Application.DisplayAlerts = True
      
    End If
    
    Application.DisplayAlerts = False
    
    vPath1 = "\\tarcds01\eCTD_Submission\TRACKERS\" & Sheet1.Range("Q1").Value & "\" & Sheet1.Range("R1").Value & "\"
    vPath2 = Sheet1.Range("Q1").Value & "-" & Sheet1.Range("R1").Value & "-" & Sheet1.Range("S1").Value
 
    'Simulate built in "SaveAs", Use desired "IntialFilename" & filter
    vFilename = Application.GetSaveAsFilename(InitialFileName:=vPath1 & vPath2, fileFilter:="Regeneron Excel Macro-Enabled Worksheet (*.xlsm), *.xlsm")
    
    If vFilename <> False Then

        'Save Backup first
         ThisWorkbook.SaveAs Filename:= vBackupPath & ActiveWorkbook.Name 'I suppose you could use vFilename also

        'Save file with desired parameters
        ThisWorkbook.SaveAs Filename:=vFilename, FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Use desired FileFormat
        
    End If
    
    Debug.Print vFilename
    
    Application.DisplayAlerts = True
    
End If

[honger]

Great! Thanks for ur help. I will try this as soon as i get home in a few

[mikeTRON]

Sure, let me know because I just wrote it out and didnt test it myself or anything

[honger]

Thank you so much Mike, you guys are great.

It wasnt working as intended at first because the SaveAs box came up twice, but i wiggled the code a bit to say SaveCopyAs and its working as intended. I really appreciate your help leading me on right path!

ActiveWorkbook.SaveCopyAs Filename:=vBackupPath & vpath2 & ".xlsm"

[honger]

well, i spoke too soon. This indeed works, it works because the first time, when user selects SaveAs it will save and make a copy. However, when the user opens the file again and user would select 'save', it will save the original file but it will not save over the copy in back-up folder.....what am i missing? Do i need to trigger something for Save?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim vFilename As Variant
Dim vPath As Variant
Dim vBackupPath As String

'Disable events so "new save" doesn't re-trigger this event
Application.EnableEvents = False

If SaveAsUI = True Then ' User selected SaveAs instead of Save

    Cancel = True ' Cancel the user's original save action
    
        'This will make this shared before saving.
        If Not ActiveWorkbook.MultiUserEditing Then
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs ActiveWorkbook.Name, accessmode:=xlShared
        Application.DisplayAlerts = True
        'MsgBox "This Tracker is Shared"
    End If
    
    Application.DisplayAlerts = False
    
    vPath1 = "\\tarcds01\eCTD_Submission\TRACKERS\" & Sheet1.Range("Q1").Value & "\" & Sheet1.Range("R1").Value & "\"
    vpath2 = Sheet1.Range("Q1").Value & "-" & Sheet1.Range("R1").Value & "-" & Sheet1.Range("S1").Value
    vBackupPath = "\\tarcds01\eCTD_Submission\TRACKERS\backup-test\"
    'Simulate built in "SaveAs", Use desired "IntialFilename" & filter
    vFilename = Application.GetSaveAsFilename(InitialFileName:=vPath1 & vpath2, fileFilter:="Regeneron Excel Macro-Enabled Worksheet (*.xlsm), *.xlsm")
    
    If vFilename <> False Then
                     
         'Save Backup
        ThisWorkbook.SaveCopyAs Filename:=vBackupPath & vpath2 & ".xlsm"        
        'Save file with desired parameters
        ThisWorkbook.SaveAs Filename:=vFilename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        
             
    End If



    Debug.Print vFilename
    
    Application.DisplayAlerts = True
    
End If