Backup on File Close Excel VBA

╄→гoц情女王★ 提交于 2019-12-02 09:43:10

The modified function below should save a backup with datetime of saving included instead of ".BAK". Modified part is commented. Also, posting properly indented helps a bunch ;)

Sub SaveWorkbookBackup()

Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean
If TypeName(ActiveWorkbook) = "Nothing" Then
Exit Sub

Set awb = ActiveWorkbook

If awb.Path = "" Then
    Application.Dialogs(xlDialogSaveAs).Show
Else: BackupFileName = awb.FullName
i = 0
While InStr(i + 1, BackupFileName, ".") > 0
    i = InStr(i + 1, BackupFileName, ".")
Wend
If i > 0 Then
BackupFileName = Left(BackupFileName, i - 1)

'Modified this part
If Application.Version >= 12 Then 
    BackupFileName = BackupFileName & "_backup_" & Format(Date, "yyyymmdd") & "-" & Format(Time, "Hhmm") & ".xlsx"
Else
    BackupFileName = BackupFileName & "_backup_" & Format(Date, "yyyymmdd") & "-" & Format(Time, "Hhmm") & ".xls"
End If
OK = False
On Error GoTo NotAbleToSave
With awb
    Application.StatusBar = "Saving this workbook..."
    .Save
    Application.StatusBar = "Saving this workbook backup..."
    .SaveCopyAs BackupFileName
    OK = True
End With
End If

NotAbleToSave:     Set awb = Nothing
    Application.StatusBar = False
    If Not OK Then
        MsgBox "Backup Copy Not Saved!", vbExclamation, ThisWorkbook.Name
    End If
End Sub
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!