Sub MakeBackup()
Dim s As String
Dim name As String
Dim a
Dim fso
'Speicherpfad und Speichername für Backupfile festlegen
s = ActiveWorkbook.Path & "\Backup"
name = s & "\" & "Backup_" & Left(ActiveWorkbook.name, 27) & "_" & Date & "_" & Left(Time, 2) & _
"_" & Mid(Time, 4, 2) & "_" & Mid(Time, 7, 2) & ".XLS"
'Wenn Backupordner noch nicht vorhanden, dann Backupordner anlegen und Backupfile speichern
If Dir(s, vbDirectory) = "" Then
MkDir (s)
ActiveWorkbook.SaveCopyAs name
Else
ActiveWorkbook.SaveCopyAs name
End If
End Sub
Gruß Ralf
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim DateinameNeu As String
DateinameNeu = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
DateinameNeu = DateinameNeu & Format(Now, " YYYY-MM-DD hh_mm") & ".xls"
ThisWorkbook.SaveCopyAs "C:\DeinSicherungspfad\" & DateinameNeu
End Sub
Dateipfad zum Speichern natürlich noch anpassen.
Gruß, Daniel