Макрос VBA для сохранения файла Excel в другое место резервной копии - PullRequest
Новая
       29

Макрос VBA для сохранения файла Excel в другое место резервной копии

5 голосов
/ 14 мая 2010

Я пытаюсь создать макрос, который запускается либо при закрытии, либо при сохранении для резервного копирования файла в другое место.
На данный момент я использовал макрос: 

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 \ Папка файла резервной копии - НЕ УДАЛЯТЬ \ Test Macro Sheet.xlsm. Есть несколько возможных причин:
Имя файла или путь не существует
Файл используется другой программой
Книга, которую вы пытаетесь сохранить, имеет то же имя, что и ...

Я знаю, что путь правильный, я также знаю, что файл больше нигде не открыт. Имя книги совпадает с именем, которое я пытаюсь сохранить, но оно должно быть просто перезаписано.

Любая помощь будет высоко ценится.

Ответы [ 3 ]

5 голосов
/ 20 мая 2010

Я изменил код так: 

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

теперь работает нормально. В сети университета должно быть что-то, что мешает работе оригинала. У меня не было с этим проблем дома.

1 голос
/ 14 апреля 2013

Я попробовал код, написанный вами, и обнаружил, что код работает, но когда я открыл файл резервной копии, я получил ту же ошибку, что и вы.

Так что я думаю, что вы, должно быть, открыли файл резервной копии, когда получили ошибку.

Я написал код, чтобы помочь с этой ошибкой: 

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

Привет

Кишлай Мишра

0 голосов
/ 25 октября 2018

Просто чтобы завершить отличный код Джо и Кишлаймшра для ясности, спасибо! 

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