Arbeitsmappe in anderen Pfad sichern

Excel VBA

Mit dem Makro kann man die aktuell geöffnete Arbeitsmappe in ein anderes Laufwerk bzw. Pfad sichern.

Zu beachten ist, dass das Makro die Datei immer versucht in das angegebene Laufwerk bzw. Verzeichnis zu sichern. Wird der Sicherungsordner verschoben, ist das Verzeichnis im Makro unbedingt anzupassen, da sonst eine Fehler ausgelöst wird.

Code

Sub ArbeitsmappeSichernPfadDatei()
'
' Speichert die aktuelle Arbeitsmappe in das Verzeichnis Pfad
'
Dim str As String
Const lw = "e:"                ' Definiert das Speicherlaufwerk
Const pfad = "E:\Sicherung"    ' Definiert den Speicherpfad

On Error GoTo fehler
    str = ActiveWorkbook.Name
    ChDrive lw
    ChDir pfad
    With ActiveWorkbook
        .SaveAs
    End With

Exit Sub

fehler:
MsgBox "Laufwerk/Verzeichnis nicht gefunden!" & vbCr & "Keine Speicherung der Datei erfolgt!", vbCritical

End Sub

Will man nach dem Speichern die Excel-Arbeitsmappe schließen, dann ist der Code wie folgt zu ergänzen

    With ActiveWorkbook
        .SaveAs
        .Close
    End With

Arbeitsmappe doppelt sichern in zwei unterschiedliche Pfade

Excel VBA

Das Makro ermöglicht, die Originalarbeitsmappe zu speichern und eine Sicherheitskopie in einem anderen Laufwerk bzw. Verzeichnis zu erstellen.

Achtung:
Das Makro durchläuft mehrere Schritte:

  • Speichern und schließen der Originalarbeitsmappe
  • Speichern und öffnen der Sicherheitskopie. Hier ist der Knackpunkt. Stoppt das Makro hier, wird mit der Kopie anstatt dem Original gearbeitet
  • Mit Hilfe des Call-Befehls wird die Originalarbeitsmappe wieder geöffnet
  • Die Sicherheitskopie wird geschlossen.

Code

Sub DateiDoppeltSpeichern()

'
' Das Makro ermöglicht es, die Originalarbeitsmappe zu speichern und eine Sicherheitskopie in einem anderen Laufwerk bzw. Verzeichnis zu erstellen.
'
'
' legt eine Sicherheitskopie der Arbeitsmappe in einem anderen Verzeichnis an
' Die Variablen lw, lw2, pfad, pfad2 sind entsprechend zu ändern
' Der Name der Sicherheitskopie wird hier "Kopie = "Arbeitsmappe_" & s_Datum & "_" & Format(s_Zeit, "hhmm") & ".xlsm" " festgelegt und ist entsprechend zu ändern
'
Dim strOriginal As String    ' Bezeichnung der Originaldatei
Dim strKopie As String      ' Bezeichnung der Kopie
Dim str_Datum As String
Dim str_Zeit As String
Dim i As Integer

Const lw = "e:"            ' Laufwerk der Originaldatei
Const lw2 = "e:"           ' Laufwerk der Sicherungskopie
Const pfad = "E:\Sicherung"         ' Pfad zur Originaldatei
Const Pfad2 = "E:\Sicherung\test"   ' Pfad zur Kopie

' Will man die Dateibenennung mit Datum und Uhrzeit vornehmen, dann ist ein Zwischenschritt notwendig. Die Uhrzeit wird mit Doppelpunkten (:) ausgegeben.
' Diese Zeichen sind in der Dateibenennung aber nicht erlaubt.
str_Datum = Date            ' Orndet dem string das Datum zu
str_Zeit = Time             ' Orndet dem string das Zeit zu

strOriginal = ActiveWorkbook.Name ' Name der Originaldatei wird festgelegt
strKopie = "Arbeitsmappe_" & str_Datum & "_" & Format(str_Zeit, "hhmm") & ".xlsm" ' Name der Sicherungskopie wird festgelegt.

On Error GoTo fehler

' Originaldatei wird gespeichert
ChDrive lw
ChDir pfad
With ActiveWorkbook
.SaveAs Filename:=strOriginal, FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", writerespassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End With

' Sicherungsdatei wird gespeichert
ChDrive lw2
ChDir Pfad2
'ActiveWorkbook.SaveAs "Test_Arbeitsmappe_" & s_Datum & "_" & Format(s_Zeit, "hhmm") & ".xlsm", ReadOnlyRecommended:=True
With ActiveWorkbook
.SaveAs Filename:=strKopie, FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", writerespassword:="", ReadOnlyRecommended:=False, CreateBackup:=True
'.Close
End With

' Achtung nachdem alle Sicherung erfolgreich erstellt wurden, ist die SICHERUNGSKOPIE geöffnet. Die ORIGINALDATEI wurde geschlossen.
' Die Originalarbeitsmappe wird geöffnet
Call ArbeitsmappeÖffnen

' Schließt die Sicherungskopie, so dass nur die Originalarbeitsmappe geöffnet bleibt
Workbooks(strKopie).Close

Exit Sub

' Dialog bei Fehlern während des Speicherns
fehler:
MsgBox "Laufwerk/Verzeichnis nicht gefunden!" & vbCr & "Das Speichern wurde abgebrochen"


End Sub

Private Sub ArbeitsmappeÖffnen()
Const lw = "E:"
Const pfad = "E:\Sicherung"
Const datei = "20101124_Test.xlsm"

    ChDrive lw
    ChDir pfad
    
    On Error Resume Next
    Workbooks.Open datei
End Sub

Achtung

Die Sicherungsdatei wird in diesem Beispiel ebenfalls im XLSM-Format abgespeichert. Die Datei enthält also die gleichen Makros wie die Originaldatei. U.U. ist es jedoch sinnvoll, dass die Kopie der Arbeitsmappe für die weitere Bearbeitung keine Makros enthält, da die Funktionen dort nicht gebraucht werden. Für diesen Fall muss die Arbeitsmappe in einem Excel-Format gespeichert werden, dass keine Makros unterstützt. Man greift also auf das Datei-Format XLSX zurück.
Für den Code bedeutet das lediglich eine kleine Änderung. Die sieht aus wie folgt:

...
strKopie = "Test_Arbeitsmappe_" & str_Datum & "_" & Format(str_Zeit, "hhmm") & ".xlsx"
...
.SaveAs Filename:=strKopie, FileFormat:=xlNormal, Password:="", writerespassword:="", ReadOnlyRecommended:=False, CreateBackup:=True
...


Alle Datei-Formate, die ab Excel 2007 unterstützt werden, können auf der Hilfe-Seite von Microsoft abgerufen werden ➡ office.microsoft.com.