Это не решает вашу текущую проблему, но я не могу вставить огромные куски кода в комментарий. Вот некоторые VBA, которые я добавляю в любую книгу, которую я хочу сделать резервную копию. Делает резервную копию всякий раз, когда она вызывается. Я обычно называю это из события Workbook_Open
. Если вы не выберете временную метку, она будет копироваться не чаще одного раза в день. Для файлов, которые меня очень волнуют, я также вызываю функцию с отметкой времени для события Workbook_AfterSave
.
Option Explicit
'This function saves a datestamped or timestamped copy of the file in a folders in the same location as the file
'It is typically called from the ThisWorkbook object with something like:
'Private Sub Workbook_Open()
' BackupThisFile
'End Sub
Function BackupThisFile(Optional AddTimestamp As Boolean = False)
Dim fPath As String
Dim fName As String
Dim fExt As String
Dim iExt As Integer
Const backupFolder As String = "Backups"
'Get file path
fPath = ThisWorkbook.path
If Right(fPath, 1) <> Application.PathSeparator Then fPath = fPath & Application.PathSeparator
'Add the backup folder name
fPath = fPath & backupFolder
If Right(fPath, 1) <> Application.PathSeparator Then fPath = fPath & Application.PathSeparator
'Create the backup directory if it doesn't already exist
On Error Resume Next
MkDir fPath
On Error GoTo 0
'Get file name
fName = ThisWorkbook.Name 'Get file name with extension
iExt = InStrRev(fName, ".") 'Find the . separating name from extension
fExt = Right(fName, Len(fName) - iExt + 1) 'Saves the extension
fName = Left(fName, iExt - 1) 'Clips the extension
'Compile path, file name, date stamp, and extension into one variable
fPath = fPath & fName & " " & Format(Date, "yyyy-mm-dd")
'Add timestamp if required
If AddTimestamp Then fPath = fPath & " " & Format(Now, "hhmmss")
'Add the file extension
fPath = fPath & fExt
'Save a copy if it doesn't already exist
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.fileExists(fPath) Then ThisWorkbook.SaveCopyAs fPath
End Function