Saving

Here are some ways to save your Excel file and simultaneously create a date and timed backup which you can copy into your workbook.

Archive Save

The first two examples strip off the .xls extension from the file name, add the date and time, then puts back the .xls

'' ***************************************************************************
'' Purpose : Save a backup version of your workbook to this workbook's directory
''           with an incremental name
'' Written : Jun-2003 by Andy Wiggins, BygSoftware.Com
'' Notes   : Attach this to, for example, a button
''
Sub SaveCopyAsToSameDirectory()
Dim lStr_TargetFile As String

    With ThisWorkbook
        .SaveCopyAs ThisWorkbook.Path & "\" & _
        Left(ThisWorkbook.Name, InStr(1, LCase(ThisWorkbook.Name), ".xls") - 1) & _
        " - " & Format(Now, "yyyymmdd hhmmss") & ".xls"
        .Save
    End With

End Sub
'' ***************************************************************************
'' Purpose : Save a backup version of your workbook to a specific directory
''           with an incremental name
'' Written : Jun-2003 by Andy Wiggins, BygSoftware.Com
'' Notes   : Attach this to, for example, a button
''
Sub SaveCopyAsToAnotherDirectory()
Dim lStr_TargetFile As String

    lStr_TargetFile = "C:\MyBackupDirectory\" & _
        Left(ThisWorkbook.Name, InStr(1, LCase(ThisWorkbook.Name), ".xls") - 1) & _
        " - " & Format(Now, "yyyymmdd hhmmss") & ".xls"

    With ThisWorkbook
        .SaveCopyAs lStr_TargetFile
        .Save
    End With

End Sub

Not as sophisticated in the way it creates the backup file name as it retains the .xls in the middle of the backup file name. This doesn't affect its use, but does look messy.

However, this one does prompt the user to check that they want to make the save.

'' ***************************************************************************
'' Purpose  : Generate archive history
'' Written  : 29-Oct-2000 by Andy Wiggins, BygSoftware.Com
''
Sub SimpleArchiveSave()
Const ctTitle = "Archive Save"
Dim lStr_NewName As String
    With ThisWorkbook
        lStr_NewName = .Path & "\" & .Name & " " & Format(Now, "yyyymmdd_hhmmss") & ".Xls"
        If vbYes = MsgBox(lStr_NewName, vbYesNo + vbCritical, ctTitle) Then
            .SaveCopyAs lStr_NewName
            .Save
        Else
            MsgBox "Not saved", vbOKOnly + vbInformation, ctTitle
        End If
        
    End With
End Sub

Save with another date and delete original

This saves the current file to today's date and deletes the original.

'' ***************************************************************************
'' Purpose  : Rename file to today and delete previous version
'' Written  : 29-Oct-2000 by Andy Wiggins - Byg Software Ltd
''
Sub SaveDateAndDelete()
Const ctTitle = "Archive Save"
Dim lStr_NewName As String
Dim lStr_CurFileName As String

        With ThisWorkbook
        lStr_CurFileName = .FullName
        lStr_NewName = .Path & "\" & .Name & " " & Format(Now, "yyyymmdd_hhmmss") & ".Xls"
        If vbYes = MsgBox(lStr_NewName, vbYesNo + vbCritical, ctTitle) Then
            .SaveAs lStr_NewName
            Kill lStr_CurFileName
        Else
            MsgBox "Not saved", vbOKOnly + vbInformation, ctTitle
        End If
    End With

End Sub

Make automatic monthly backups

This creates a monthly backup on the last working day of the month after taking into account weekends.

'' ***************************************************************************
'' Purpose  : Create backup at month end
'' Written  : 08-Jul-2004 by Andy Wiggins - Byg Software Ltd
''
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lDat_Today As Date
Dim lDat_Tomorrow As Date
Dim lStr_TargetFile As String
    lDat_Today = Date
 
    If "Fri" = Format(Date, "ddd") Then
        lDat_Tomorrow = Date + 3
    Else
        lDat_Tomorrow = Date + 1
    End If    
    With ThisWorkbook
        If Month(lDat_Today) = Month(lDat_Tomorrow) Then
            '' Do nothing, we're still in the same month
        Else
            '' Tomorrow is a new month so make a backup today
            .SaveCopyAs ThisWorkbook.Path & "\" & _
                Left(ThisWorkbook.Name, _
                    InStr(1, LCase(ThisWorkbook.Name), ".xls") - 1) & _
                " - " & Format(Now, "yyyymmdd") & ".xls"
        End If
        
        '' Save the original
        .Save
    
    End With
End Sub

 

Click here for Save And BackUp the complete solution from Byg Software.

Published: 08-Feb-2004
Last edited: 01-Mar-2011 20:51