Question

我希望Excel在没有提示给用户的情况下自动备份文件关闭的工作簿。我在网上找到了优秀的代码（忘记了源代码），但备份FileType正在更改为我无法打开的BAK文件。我该如何解决这个问题。这两个文件都在同一个文件夹中。备份应该具有相同的文件名和“-bak”或“.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

Answer 1

下面的修改后的功能应该保存包含保存日期时间而不是＆＃34; .BAK＆＃34;的备份。修改了部分进行了评论。此外，正确缩进发布有助于一堆;）

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

1 个答案: