Save a workbook backup
1999-12-20 Workbooks 0 221
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 SubThe 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