Backup Current File

This is one of my favorites. It saves a copy of the current file in the ‘Backup’ directory if one exists under the directory in which the file is currently saved. It saves the files with an incrementing two digit number after the filename (before the .xls extension). A cap of 50 backups is imposed just to keep from taking up too much disk space (my models tend to be BIG).

' Save a copy of the current file.
' Copyright under GPL by Mark Grimes
' Keyboard Shortcut: Crtl+Shift+S
'    Will save in the "Backup" subdirectory if it exists.
'    Will attempt to add an index number upto 50.
'
Sub mgSaveBackup()
    p0$ = ActiveWorkbook.Path
    If Dir(p0$ & "\Backup", vbDirectory) <> "" Then
        p$ = p0$ & "\Backup"
    End If

    n0$ = ActiveWorkbook.Name
    If Right(n0$, 4) <> ".xls" And Right(n0$, 4) <> ".XLS" Then
        MsgBox "File must be a previously saved '.xls' file."
        End
    End If
    n$ = Left(n0$, Len(n0$) - 4)

    i = 0
    Do
        i = i + 1
    Loop Until (Dir(p$ & "\" & n$ & "." & Application.Text(i, "00") & ".xls") = "") Or (i > 50)

    If i > 50 Then
        MsgBox "No more than 50 backup's can be made."
        End
    End If

    response = MsgBox("File to be backed-up as:" & Chr(10) _
            & p$ & "\" & n$ & "." & Application.Text(i, "00") & ".xls", vbOKCancel)

    If response = vbOK Then
        'FileCopy p0$ & "\" & n0$, p$ & "\" & n$ & "." & i & ".xls"
        ActiveWorkbook.SaveCopyAs p$ & "\" & n$ & "." & Application.Text(i, "00") & ".xls"
    Else
        MsgBox "Backup aborted!"
    End If
End Sub