将 Excel 文件保存到不同备份位置的 VBA 宏

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

提问by Joe Taylor

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...

运行时错误“1004”；
Microsoft Office Excel 无法访问文件“T:\TEC_SERV\Backup 文件夹 - 请勿删除\Test Macro Sheet.xlsm”。有多种可能的原因：
文件名或路径不存在
文件正被另一个程序
使用 您试图保存的工作簿与...

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.

任何帮助将非常感激。

采纳答案by Joe Taylor

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.

它现在工作正常。大学网络上肯定有什么东西阻止了原版运行。我在家里没有问题。

回答by user2279080

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 [email protected]

如果您对答案不满意或有任何疑问，请发送电子邮件至 [email protected]

Regards

问候

Kishlay Mishra

基什莱·米什拉

回答by Riaz Khan

Just to complete joe's and kishlaymshr excellent code for clarity, thanks!:

为了清楚起见，为了完成 joe 和 kishlaymshr 的优秀代码，谢谢！：

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