Следует регулярно делать резервную копию данных, так как любое неправильное изменение другим пользователем или случайное удаление файла Excel может испортить много времени и информации.

В этой статье мы расскажем, как сделать резервную копию файла Excel с помощью VBA.

В этой статье мы рассмотрим два разных способа резервного копирования с использованием кода VBA. Мы написали два макроса для создания резервной копии файла Excel.

Макрос «SaveWorkbookBackup» создаст резервную копию файла Excel с расширением «.bak» в той же папке, где сохранена активная книга.

ArrowBackUpFileCreated

Макрос «SaveWorkbookBackupToFloppy» создаст копию активной книги на диске D, которая будет действовать как файл резервной копии для активной книги.

ArrowBackUpCopyCreated

Объяснение кода

Если не в порядке, то MsgBox «Резервная копия не сохранена!», VbExclamation, ThisWorkbook.Name End If Above code используется для отображения сообщения об ошибке, когда во время выполнения макроса возникает ошибка времени выполнения.

NotSaveDialogBox

Если AWB.Path = «» Then ‘Отображение диалогового окна «Сохранить как» для сохранения файла 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]