VBA Macro to save excel file to another backup location

Question

I am trying to create a macro that either works when closing or when saving to backup the file to another location.
Currently, the Macro I 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 backs up the file for the first time, however, if it is repeated, I get:

Runtime 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:
File name or path does not exist
The file is being used by another program.
The book you are trying to save has the same name as ...

I know that the path is correct, I also know that the file is not open anywhere. The workbook has the same name as me, which I am trying to save, but should just overwrite.

Any help would be greatly appreciated.

Answer 1

I changed 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 

Now it works great. There must be something on the university network that prevents the launch of the original. I had no problems with this at home.

Answer 2

I tried the code you wrote, and I found that the code worked, but when I opened the backup file, I got the same error as you.

So, I think you should open the backup file when you get the error.

I wrote code to help with this error:

 If ActiveWorkbook.Path = "D:\MOVIES\excel test\Backup" Then Exit Sub Else Application.DisplayAlerts = False ActiveWorkbook.SaveCopyAs Filename:="D:\MOVIES\excel test\Backup\" & _ ActiveWorkbook.Name ActiveWorkbook.Save Application.DisplayAlerts = True 

I do not think there was anything wrong with the university network.

If you are not satisfied with the answer or have any doubts, write to me at [e-mail]

Hi

Kishlai Mishra

Answer 3

Just to complete Joe and kishlaymshr a great code for clarity, thanks!

 Sub AutoBackup() If ActiveWorkbook.Path = "F:\TEMP\" Then Exit Sub Else 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 ActiveWorkbook.SaveCopyAs Filename:="F:\TEMP\" & _ Test1Str & "-" & TestStr & "-" & ActiveWorkbook.Name ActiveWorkbook.Save Application.DisplayAlerts = True End If End Sub 

Answer 4

Thank you very much, it works great. Can the above code work automatically? For example, before closing Excel or every 10 minutes.