Way too much repetitious code making for way too much maintenance,
possibly. I'd go with something more like this...

Option Explicit

' Revised from original code by Greg Glynn

Const msPath$ = "E:\Backups\" '*** Change this to suit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
'Backup the data if the sheet was not opened in ReadOnly mode
If ThisWorkbook.ReadOnly Then Exit Sub

Dim sComment$
Comment = InputBox("Add a comment?")
If Comment < "" Then
Comment = " - " & Replace(Comment, "/", "-")
End If
'Create a backup
CreateBackup Comment

End Sub

Private Sub Workbook_Open()
'Backup the data if the sheet was not opened in ReadOnly mode
If Not ThisWorkbook.ReadOnly Then CreateBackup

End Sub

Private Sub CreateBackup(Optional Comment$)
Dim sFileName$, sFile$

DoEvents
With Application
.EnableEvents = False: .ScreenUpdating = False: .Caption = "***
Auto Backup ***"
End With

sFileName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name,
".") - 1)
sFile = msPath & " " & sFileName & " " & Format(Now(), "YYYY-MM-DD
hh-mm-ss")
sFile = sFile & " " & Environ$("Username")
sFile = sFile & Comment & Mid(ActiveWorkbook.Name,
InStrRev(ActiveWorkbook.Name, "."))
On Error Resume Next
ActiveWorkbook.SaveCopyAs sFile

Application.StatusBar = "Saved " & sFileName & " " &
Format(FileLen(sFile), "#,#") & " bytes."

With Application
.EnableEvents = True: .ScreenUpdating = True: .Caption = ""
End With
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus