Saving

'' ***************************************************************************
'' 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

'' ***************************************************************************
'' 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

'' ***************************************************************************
'' 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

'' ***************************************************************************
'' 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