在文件上备份关闭Excel VBA [英] Backup on File Close Excel VBA

问题描述

我希望Excel在文件关闭时自动备份工作簿，而不会提示用户.我在网上找到了出色的代码(忘记了源代码)，但是备份FileType更改为无法打开的BAK文件. 我该如何解决此问题.这两个文件将位于同一文件夹&中.备份文件应具有相同的文件名& "-bak"或".bak".

I want Excel to automatically backup a workbook on file close without prompts to the user. I found the excellent code below online (forgot source) but the backup FileType is changing to a BAK File that I cannot open. How do I fix this problem. Both files will be in the same folder & the backup should have same file name & "-bak" or ".bak".

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)
        BackupFileName = BackupFileName & ".bak"
        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

推荐答案

下面修改后的函数应保存一个包含保存日期时间的备份，而不是".BAK".修改的部分被评论.另外，以适当的缩进方式发布有助于一堆;)

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

这篇关于在文件上备份关闭Excel VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！