Search code examples
vbaexcelexcel-2007

VBA Macro to save an excel file to a different backup location


I am trying to create a Macro that either runs on close or on save to backup the file to a different location.
At the moment the Macro I have used is:

Private Sub Workbook_BeforeClose(Cancel As Boolean)  
'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)  
    'Saves the current file to a backup folder and the default folder  
    'Note that any backup is overwritten  
    Application.DisplayAlerts = False  
    ActiveWorkbook.SaveCopyAs Filename:="T:\TEC_SERV\Backup file folder - DO NOT DELETE\" & _ 
    ActiveWorkbook.Name  
    ActiveWorkbook.Save  
    Application.DisplayAlerts = True  
End Sub  

This creates a backup of the file ok the first time, however if this is tried again I get:

Run-Time Error '1004';
Microsoft Office Excel cannot access the file 'T:\TEC_SERV\Backup file folder - DO NOT DELETE\Test Macro Sheet.xlsm. There are several possible reasons:
The file name or path does not exist
The file is being used by another program
The workbook you are trying to save has the same name as a...

I know the path is correct, I also know that the file is not open anywhere else. The workbook has the same name as the one I'm trying to save over but it should just overwrite.


Solution

  • I modified the code to this:

    Sub BUandSave2()
    'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    'Saves the current file to a backup folder and the default folder
    'Note that any backup is overwritten
    Dim MyDate
    MyDate = Date    ' MyDate contains the current system date.
    Dim MyTime
    MyTime = Time    ' Return current system time.
    Dim TestStr As String
    TestStr = Format(MyTime, "hh.mm.ss")
    Dim Test1Str As String
    Test1Str = Format(MyDate, "DD-MM-YYYY")
    
    Application.DisplayAlerts = False
    '
    Application.Run ("SaveFile")
    '
    ActiveWorkbook.SaveCopyAs Filename:="T:\TEC_SERV\Backup Test\" & Test1Str & " " & TestStr & " " & ActiveWorkbook.Name
    ActiveWorkbook.Save
    Application.DisplayAlerts = True
    End Sub
    

    it now works fine. There must be something on the university network that prevents the original from running. I had no problems with it at home.