一个人应该定期对数据进行备份，因为其他用户的任何错误修改或意外删除excel文件都可能浪费大量时间和信息。

在本文中，我们将介绍如何使用VBA备份Excel文件。

在本文中，我们将介绍两种使用VBA代码进行备份的方法。我们已经编写了两个用于备份Excel文件的宏。

“ SaveWorkbookBackup”宏将在保存活动工作簿的同一文件夹中创建扩展名为“ .bak”的Excel文件的备份。

ArrowBackUpFileCreated

宏“ SaveWorkbookBackupToFloppy”将在驱动器D中创建活动工作簿的副本，该副本将用作活动工作簿的备份文件。

ArrowBackUpCopyCreated

代码说明

如果还不行，则MsgBox“未保存备份副本！”，vbExclamation，ThisWorkbook.Name结束如果在宏执行期间发生某些运行时错误，则上述代码用于显示错误消息。

NotSaveDialogBox

如果AWB.Path =“”则’显示另存为对话框以保存文件Application.Dialogs（xlDialogSaveAs）.Show上述代码用于显示“另存为”对话框，如果在进行文件备份之前未保存文件。

SaveAs Dialog Box

请遵循以下代码

Option Explicit

Sub SaveWorkbookBackup()

Dim AWB As Workbook, BackupFileName As String, i As Integer, Ok As Boolean

On Error GoTo NotAbleToSave



Set AWB = ActiveWorkbook

'Assign full path of file along file name to variable BackupFileName

BackupFileName = AWB.FullName

'Checking whether file is saved

'If file is not saved then saving the file

If AWB.Path = "" Then

'Displaying Save as dialog box for file saving

Application.Dialogs(xlDialogSaveAs).Show

Else



'Removing file extension from file name

i = 0

While InStr(i + 1, BackupFileName, ".") > 0

'Find the extension of file

i = InStr(i + 1, BackupFileName, ".")

Wend



If i > 0 Then BackupFileName = Left(BackupFileName, i - 1)



'Adding back up extension ".bak" with file name

BackupFileName = BackupFileName & ".bak"

Ok = False



With AWB

.Save

'Creating Backup of file

.SaveCopyAs BackupFileName

Ok = True

End With

End If

NotAbleToSave:

'Code for error handling

Set AWB = Nothing

If Not Ok Then

MsgBox "Backup Copy Not Saved!", vbExclamation, ThisWorkbook.Name

End If

End Sub

Sub SaveWorkbookBackupToFloppy()

Dim AWB As Workbook, BackupFileName As String, i As Integer, Ok As Boolean

Dim DriveName As String

On Error GoTo NotAbleToSave



'Specify the path for making back up in D drive

DriveName = "D:\"

'Initializing the variables

Set AWB = ActiveWorkbook

BackupFileName = AWB.Name

Ok = False

'Checking whether file is saved

'If file is not saved then saving the file

If AWB.Path = "" Then

'Displaying Save as dialog box for file saving

Application.Dialogs(xlDialogSaveAs).Show

Else

'Deleting file if backup file already exists

If Dir(DriveName & BackupFileName) <> "" Then

Kill DriveName & BackupFileName

End If

With AWB

.Save

'Creating the back up file

.SaveCopyAs DriveName & BackupFileName

Ok = True

End With

End If

NotAbleToSave:

'Code for error handling

Set AWB = Nothing



If Not Ok Then

MsgBox "Backup Copy Not Saved!", vbExclamation, ThisWorkbook.Name

End If

End Sub

如果您喜欢此博客，请在Facebook和Facebook上与您的朋友分享。

我们很希望收到您的来信，请让我们知道我们如何才能改善我们的工作并使您的工作更好。写信给我们[email protected]