Question

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

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文件夹 - 请勿删除\测试宏Sheet.xlsm。有几个可能的原因：
  文件名或路径不存在   该文件正由另一个程序使用   您要保存的工作簿与...的名称相同。

我知道路径是正确的，我也知道该文件在其他任何地方都没有打开。该工作簿的名称与我试图保存的名称相同，但它应该覆盖。

非常感谢任何帮助。

Answer 1

我将代码修改为：

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

它现在工作正常。大学网络上必须有一些东西阻止原件运行。我家里没问题。

Answer 2

我尝试了你编写的代码，我发现代码工作正常，但是当我打开备份文件时，我得到了同样的错误。

所以我认为你在收到错误时必须打开备份文件。

我写了一个代码来帮助解决这个错误：

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

我认为大学网络没有任何问题。

如果您对答案不满意或有任何疑问，请发送电子邮件至kishlaymshr19@gmail.com

此致

Kishlay Mishra

Answer 3

为清晰起见，只需完成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

VBA宏将excel文件保存到其他备份位置

3 个答案: