[英]Backup on File Close Excel VBA
I want Excel to automatically backup a workbook on file close without prompts to the user. 我希望Excel在文件关闭时自动备份工作簿,而不会提示用户。 I found the excellent code below online (forgot source) but the backup FileType is changing to a BAK File that I cannot open.
我在网上找到了出色的代码(忘记了源代码),但是备份FileType更改为无法打开的BAK文件。 How do I fix this problem.
我该如何解决此问题。 Both files will be in the same folder & the backup should have same file name & "-bak" or ".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
The modified function below should save a backup with datetime of saving included instead of ".BAK". 以下修改后的功能应保存一个包含保存日期时间的备份,而不是“ .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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.