5
votes

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.

Any help would be much appreciated.

3
I cannot reproduce this behaviour (at least, not with Excel 2002). Works fine there. Are you sure you do not have your backup file open? And are you aware that when you open your backup file, it will try to make a backup of itself into the backup folder?Doc Brown
Yes I am aware of that, thats one of the issues with the on close command that made me think to go to the on save command. This would remove the problem from the backup as it wouldn't be saved. The backup file is definitely not open. Its a bit of a puzzler. I also originally ran the command from a customized button in the toolbar, but had issues with people forgetting to click it. Hence the on close event being substituted in.Joe Taylor

3 Answers

5
votes

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.

1
votes

I tried the code written by you and I found the code worked but when I opened the backup file I got the same error you got.

So I think you must have opened the backup file when you got the error.

I wrote a 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 don't think there was anything wrong with the university network.

If you are not satisfied with the answer or have any doubt please email me at kishlaymshr19@gmail.com

Regards

Kishlay Mishra

0
votes

Just to complete joe's and kishlaymshr excellent 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