Home

Consulting

Recruiting

Training

Software

Publishing

About Us

Saving Back Versions Of Your Code

Copy the following code to your Workbook_BeforeSave routine

Substitute your user id if you want the code to automatically back up for you. You must name you program xxxxxxxxxxxxxxxxx.000.xls where the 000 will be updated each time you save the code. Also the I:\Backup directory must exist

'********************************************************************
'  http://www.KravatzInc.com    1-866-XLS-PROG
'
'  This code is copyrighted by Kravatz, Inc. (c) 2007 All Rights Reserved.
'  You may use this code as long as this message appears
'  There is no warranty made to the fitness or suitablilty of this code
'  and by using it you hold Kravatz, Inc. harmless for any damages
'  that may result from its use.  This code is supplied as is.
'  
'********************************************************************
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Application.UserName <> "" Then
    Exit Sub
End If

Cancel = True
SaveNewVersion
MoveOldVersionsToBackup
End Sub

Copy the module SaveBackupVersion.bas into you program which contains the following code:

'********************************************************************
'  http://www.KravatzInc.com    1-866-XLS-PROG
'
'  This code is copyrighted by Kravatz, Inc. (c) 2007 All Rights Reserved.
'  You may use this code as long as this message appears
'  There is no warranty made to the fitness or suitablilty of this code
'  and by using it you hold Kravatz, Inc. harmless for any damages
'  that may result from its use.  This code is supplied as is.
'  
'********************************************************************
Option Explicit
'1.0.1 9/12/07
'
'
' 1.0.1 9/12/07 Added MoveOldVersionsToBackup


'
Sub MoveOldVersionsToBackup()
'Ctrl+Shift+S
'Gets called via the workbook.beforeSave event

Dim sName As String, sRoot As String
Dim iVersion As Integer
Dim sSave As String
Dim bEvents As Boolean
Dim sBackup  As String
Dim i As Long

bEvents = Application.EnableEvents
Application.EnableEvents = False

sName = ThisWorkbook.Name


iVersion = Val(Right(sName, 6))
For i = iVersion - 1 To 1 Step -1
    sRoot = Mid(sName, 1, Len(sName) - 7)
    sSave = "I:\" & sRoot & Format(i, "000") & ".xls"
    sBackup = "I:\Backup\" & sRoot & Format(i, "000") & ".xls"
    On Error Resume Next
    Name sSave As sBackup
    If Err = 0 Then
        'ok file not found
    ElseIf Err = 53 Then
        MsgBox "Done"
        Application.EnableEvents = bEvents
        Exit Sub
    Else
        MsgBox Err & " " & Error
        Stop
    End If
    
Next





MsgBox "Done"

Application.EnableEvents = bEvents
End Sub

Sub SaveNewVersion()
'Ctrl+Shift+S
'Gets called via the workbook.beforeSave event

Dim sName As String, sRoot As String
Dim iVersion As Integer
Dim sSave As String
Dim bEvents As Boolean

bEvents = Application.EnableEvents
Application.EnableEvents = False

sName = ThisWorkbook.Name


iVersion = Val(Right(sName, 6))
iVersion = iVersion + 1
sRoot = Mid(sName, 1, Len(sName) - 7)
sSave = "I:\" & sRoot & Format(iVersion, "000") & ".xls"
ActiveWorkbook.SaveAs sSave


MsgBox "File saved as " & sSave
Application.EnableEvents = bEvents

End Sub