Sikkerhetskopiere arbeidsboken

Makroen nedenfor kan benyttes til å lagre en kopi av den aktive arbeidsboken i den samme mappen som arbeidsboken befinner seg. Sikkerhetskopien får filendelsen ".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

Makroen nedenfor kan benyttes til å lagre en kopi av den aktive arbeidsboken på en diskett i stasjon A: (valg av stasjon kan selvfølgelig endres i kildekoden. Sikkerhetskopien får samme navn som den originale arbeidsboken.

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

Dokumentet er sist oppdatert 1999-12-20 12:37:12 Utskriftsvennlig versjon