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

vybvopom  于 12个月前  发布在  其他
关注(0)|答案(3)|浏览(72)

我正在尝试创建一个宏,该宏在关闭或保存时运行,以便将文件备份到其他位置。
目前我使用的宏是:

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

字符串
这会在第一次创建文件的备份,但是如果再次尝试,我会得到:
运行时错误“1004”;
Microsoft Office Excel无法访问文件“T:\TEC_SERV\Backup file folder - DO NOT REPORT\Test Macro Sheet. xlsm”。可能有以下几个原因:
文件名或路径不存在
该文件正被另一个程序使用
您试图保存的工作簿与.同名。
我知道路径是正确的,我也知道文件没有在其他地方打开。工作簿与我试图保存的工作簿同名,但它应该覆盖。

aij0ehis

aij0ehis1#

我把代码修改成这样:

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

字符串
它现在工作得很好。大学网络上一定有什么东西阻止了原件的运行。我在家里没有遇到任何问题。

mbzjlibv

mbzjlibv2#

我尝试了你写的代码,我发现代码工作,但当我打开备份文件,我得到了相同的错误,你得到.
所以我想你一定是在收到错误时打开了备份文件。
我写了一段代码来帮助解决这个错误:

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

字符串
我不认为大学网络有什么问题。

ddrv8njm

ddrv8njm3#

只是为了完成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

字符串

相关问题