Dim BackupFileName, CurrentWorkbook, CreateABackup, OnlyOneWorkBook, WorkBookIsABackup
Private Sub Workbook_Open()
'Assumptions:
'1. The Folder 'BACKUP' exists. This code does NOT create the folder if it doesn't exist.
'2. The Master Workbook does NOT have a '-' in the name.
' You can change the BACKUP Workbook delimiter here.
BackUpFileDelimiter = "-"
'
'Possibilities:
'1. If this is the first time TODAY the Master Workbook has been opened,
' then create a BACKUP Workbook and notify user.
'2. If this is NOT the first time TODAY the Master Workbook has been opened,
' then do NOT create a BACKUP Workbook and notify user.
' This could result in LOST DATA if the Master Workbook is changed
' as the BACKUP was created the FIRST time Master Workbook was opened.
'3. The user opens the BACKUP Workbook. As the BACKUP Workbook has this code,
' the code needs to allow the BACKUP Workbook to be opened without incident.
' If the Master Workbook is open when the BACKUP Workbook is opened the
' BACKUP Workbook is closed to be certain the user doesn't make changes to
' the BACKUP Workbook thinking they are making changes to the Master Workbook.
' If you want to open the BACKUP Workbook, close all other Workbooks first.
'Backup file format "BackUpFileDelimiter dd.mm.yyyy.xlms" or most likely " - dd.mm.yyyy.xlms"
FormatSaveDate = " " & BackUpFileDelimiter & " " & Right("0" & Day(Now()), 2) & "." & Right("0" & Month(Now()), 2) & "." & Year(Now()) & ".xlsm"
BackupFileName = Application.ActiveWorkbook.Path & "\Backup\" & Replace(Application.ActiveWorkbook.Name, ".xlsm", "") & FormatSaveDate
'Is there a Backup Workbook already open? If so, close it and continue.
OnlyOneWorkBook = "NO"
Call CloseOpenBackupWorkbook(BackUpFileDelimiter)
If OnlyOneWorkBook = "YES" And WorkBookIsABackup = "YES" Then 'Only one workbook and it is a backup
MsgBox "This is a BACKUP Workbook so NO NEED to created a BACKUP." & _
vbCrLf & vbCrLf & "Be CAREFUL as changes to this BACKUP Workbook will NOT be included in the Master Workbook."
Exit Sub
End If
'Is there already a Backup Workbook? If so, skip saving a new one.
Call DoesWorkbookExist
If CreateABackup = "NO" Then
MsgBox "This is already BACKUP Workbook so NO Backup has been created." & _
vbCrLf & vbCrLf & "Be CAREFUL as changes to this Workbook are not included in the BACKUP Workbook created earlier today."
Exit Sub 'Backup Workbook exists, we are done here
End If
CurrentWorkbook = Application.ActiveWorkbook.Name
On Error Resume Next
ActiveWorkbook.SaveAs Filename:=BackupFileName
If Err.Number <> 0 Then
MsgBox "Error: " & Err.Description & vbCrLf & vbCrLf & "Most likely the BackUp Folder does NOT Exist." & _
vbCrLf & vbCrLf & "The program will stop now."
Exit Sub
End If
MsgBox "A BACKUP Workbook has been created." & vbCrLf & vbCrLf & BackupFileName
'Non backup path
RemoveBackupFolder = Replace(Application.ActiveWorkbook.Path, "\Backup", "")
SaveOriginalFule = RemoveBackupFolder & "\" & CurrentWorkbook
Workbooks.Open Filename:=SaveOriginalFule
End Sub
Sub CloseOpenBackupWorkbook(BackupDelimiterCharacter)
Dim wb As Workbook
WorkbookCounter = 0
WorkbooktoClose = ""
WorkBookIsABackup = "NO"
For Each wb In Application.Workbooks
If InStr(wb.Name, BackupDelimiterCharacter) > 0 Then
WorkbooktoClose = wb.Name
WorkBookIsABackup = "YES"
End If
WorkbookCounter = WorkbookCounter + 1
Next wb
If WorkbookCounter = 1 Then 'only ONE Workbook open don't close it
OnlyOneWorkBook = "YES"
Else
OnlyOneWorkBook = "NO" 'MORE than ONE Workbook open
If WorkBookIsABackup = "YES" Then
Workbooks(WorkbooktoClose).Close SaveChanges:=False 'close the BACKUP Workbook
End If
End If
End Sub
Sub DoesWorkbookExist()
If Dir(BackupFileName) = "" Then 'Check Workbook exists or not
CreateABackup = "YES" 'Workbook is not available
Else
CreateABackup = "NO" 'Workbook is available
End If
End Sub
