Save a workbook backup
1999-12-20 Workbooks 0 272
The macro below can be used to create a backup copy of the active workbook. The backup workbook will be stored in the same folder as the active workbook with the file extension ".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 macro below can be used to save a copy of the active workbook to a floppy disk in station A:. The backup copy will have the same name as the active workbook.Sub SaveWorkbookBackupToFloppyA()
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.Name
OK = False
On Error GoTo NotAbleToSave
If Dir("A:" & BackupFileName) <> "" Then
Kill "A:" & BackupFileName
End If
With awb
Application.StatusBar = "Saving this workbook..."
.Save
Application.StatusBar = "Saving this workbook backup..."
.SaveCopyAs "A:" & 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