Arbeitsmappe doppelt sichern in zwei unterschiedliche Pfade
Das Makro ermöglicht, die Originalarbeitsmappe zu speichern und eine Sicherheitskopie in einem anderen Laufwerk bzw. Verzeichnis zu erstellen.
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
- mithilfe des Call-Befehls wird die Originalarbeitsmappe wieder geöffnet
- sie 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
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.
Gib mir gerne einen Kaffee ☕ aus ❗️
Wenn dir meine Beiträge gefallen und geholfen haben, dann kannst du mir gerne einen Kaffee ☕️ ausgeben.
• 
Bitcoin Address: bc1qfuz93hw2fhdvfuxf6mlxlk8zdadvnktppkzqzj
Follow Me❗️