Einfaches Backup für Word-Dokumente

Word – SaveDuplicateWithTimeCode

Worum geht es?

Beim Arbeiten an wichtigen Dokumenten lege ich ständig neue Versionen an um nach eventuellen menschlichen oder Computer-basierten Fehlern möglichst wenig Arbeit einzubüßen. Dadurch ändert sich ständig der Dateiname. Um Abhilfe zu schaffen habe ich dieses Makro geschrieben. Auf Knopfdruck wird mit aktuellem Datum und aktueller Zeit eine Kopie gespeichert und man arbeitet in der eigentlichen Version weiter.

ACHTUNG: Damit ist man noch nicht vor versehentlichem Löschen, bzw. Virus-Befall geschützt. Also weiterhin ab und zu auf ein Read-Only Medium kopieren…

Installation

Alt+F11 öffnet den VBA-Editor. Den Code in das „ThisDocument“ der Normal.dot kopieren.

Zurück im Word im Menü „Extras“ „Anpassen“ wählen. Hier unter „Befehle“ Makros suchen und im rechten Fenster „Normal.ThisDocument.SaveDuplicateWithTimeCode“ in die Symbolleiste neben den Original-Speicherknopf ziehen. Mit rechtem Maus-Button auf diesem Symbol „Standard“ auswählen und ein Symbol aussuchen.

Anwendung

Einfach auf den neuen Button klicken. Es wird ein Duplikat gespeichert, danach wird auch das Ursprungsdokument unter dem eigentlichen Namen noch einmal gespeichert. Beim ersten Start wird nach dem Dokumenten-Name gefragt, und ob die Duplikate in einem eigenen Unterordner gespeichert werden sollen.

Kompatibilität

Getestet mit Word 2003 und Word 2007.

Code

 Option Explicit
'© Karsten Hartlieb 2010
Sub SaveDuplicateWithTimeCode()
Dim tmpString As String, BaseName As String, BasePath As String, PathName As String, jetzt As Date, newName As String
Dim extension As String
    On Error Resume Next
    BaseName = ActiveDocument.CustomDocumentProperties("Speichername").Value
    PathName = ActiveDocument.CustomDocumentProperties("Speicherpfad").Value
    BasePath = ActiveDocument.Path
    If Len(BaseName) = 0 Then
        If MsgBox("Soll der aktuelle Name (" & ActiveDocument.Name & ") verwendet werden?", vbOKCancel, "Speichername noch nicht gesetzt...") = vbOK Then
            ActiveDocument.CustomDocumentProperties.Add Name:="Speichername", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=ActiveDocument.Name
            BaseName = ActiveDocument.Name
        Else
            tmpString = InputBox("Bitte den zu verwendenden Namen eingeben", "Dateiname")
            If Len(tmpString) = 0 Then
                MsgBox "Kein Name angegeben, Skript wird abgebrochen"
                Exit Sub
            Else
                ActiveDocument.CustomDocumentProperties.Add Name:="Speichername", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=tmpString
                BaseName = tmpString
            End If
        End If
    End If
    If Len(PathName) = 0 Then
        If MsgBox("Sollen die Sicherungen in einem eigenen Ordner landen?", vbOKCancel, "Speichername noch nicht gesetzt...") = vbCancel Then
            ActiveDocument.CustomDocumentProperties.Add Name:="Speicherpfad", LinkToContent:=False, Type:=msoPropertyTypeString, Value:="NoDedicPath"
            PathName = ""
        Else
            tmpString = InputBox("Bitte den zu verwendenden Orndernamen eingeben", "Ordnername")
            If Len(tmpString) = 0 Then
                MsgBox "Kein Name angegeben, Skript wird abgebrochen"
                Exit Sub
            Else
                ActiveDocument.CustomDocumentProperties.Add Name:="Speicherpfad", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=tmpString
                BaseName = tmpString
            End If
        End If
    Else
        If PathName = "NoDedicPath" Then
            PathName = ""
        End If
    End If
    If Len(PathName) > 0 Then
        tmpString = BasePath & "" & PathName
        If Right(Trim(tmpString), 1) <> "" Then
            tmpString = tmpString & ""
        End If
        If Not (Dir(tmpString, vbDirectory) <> "") Then
            MkDir tmpString
        End If
    End If
    jetzt = Now()
    newName = Year(jetzt) & "-" & Format(Month(jetzt), "00") & "-" & Format(Day(jetzt), "00")
    newName = newName & " " & Format(Hour(jetzt), "00") & "_" & Format(Minute(jetzt), "00")
    newName = newName & " " & BaseName '& extension
    
    If Len(PathName) > 0 Then
        ChangeFileOpenDirectory BasePath & "" & PathName
    End If
    ActiveDocument.SaveAs fileName:=newName
End Sub