Habe hier in Forum ein Code von Franz gefunden;
originelle Code Beschreibung
1) Feststellung, ob in der geöffneten Arbeitsmappe Änderungen gegenüber der gespeicherten Version gemacht wurden
2) Wenn ja, dann automatisches Speichern einer Kopie in einem einstellbaren Intervall (z.B. 5 min). Dabei soll die Kopie im gleichen Verzeichnis abgelegt werden wie das Original, jedoch mit dem Dateinamen "Kopie von .xls". Die Kopie soll auch nach dem Beenden von Excel erhalten bleiben.
3) Wenn keine Änderungen gemacht wurden, braucht die Kopie nicht erstellt werden.
Ich suche was ähnliches, leider sind meine Kenntnisse in VBA noch extrem begrenzt.
1 Feststellung, ob in eine Test.xlsm Mappe Änderungen gemacht wurden
2) Wenn ja, dann automatisches Speichern einer Kopie in einem einstellbaren Intervall (alle 5 Min).
Dabei soll die Kopie (ohne Makros) im bestimmten Verzeichnis ("C:\Dokumente und Einstellungen\Sicherung\") als .xlsx abgelegt werden.
Alle Tabellen Blätter die ausgeblendet sind die sollen nicht mitgespeichert werden,
jedoch mit dem Dateinamen "BuckUp .xls". Die Kopie soll auch nach dem Beenden von Excel erhalten bleiben.
3) Wenn keine Änderungen gemacht wurden, braucht die Kopie nicht erstellt werden.
Wäre super, wenn mir jemand helfen könnte, und den unteren Code von Franz anpassen konnte
Ich Danke Euch für Euer Mühen
Freue mich über jeden Hinweis!
Netten Gruß
Daniel
' Code in einem allgemeinen Modul:
Public Zeitpunkt As Date
Sub Sichern_Start()
Call ArbeitsmappenSichern
End Sub
Sub Sichern_Stop()
On Error Resume Next
Application.OnTime Earliesttime:=Zeitpunkt, Procedure:="ArbeitsmappenSichern", schedule:= _
False
End Sub
Sub ArbeitsmappenSichern()
Dim wb As Workbook
On Error GoTo Fehlerbehandlung
Application.StatusBar = "Sicherung der Arbeitsmappen läuft"
For Each wb In Application.Workbooks
If Windows(wb.Name).Visible = True Then
If wb.Saved = False Then
wb.SaveCopyAs Filename:=wb.Path & "\BackUp_von_" & wb.Name
End If
End If
Next
Zeitpunkt = Now + CDate("00:05:00")
Application.OnTime Earliesttime:=Zeitpunkt, Procedure:="ArbeitsmappenSichern"
Application.StatusBar = flase
GoTo Ende
Fehlerbehandlung:
MsgBox "Fehler " & Err.Number & " ist aufgetreten!" & vbLf & Err.Description & vbLf & vbLf & _
_
"Neu angelegte Datei wurde wahrscheinlich noch nie gespeichert! Bitte Datei Speichern."
wb.Activate
Application.Dialogs(xlDialogSaveAs).Show
Resume Next
Ende:
End Sub
'code unter diese Arbeitsmappe
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime Earliest:=Zeitpunkt, Procedure:="ArbeitsmappenSichern", schedule:=False
End Sub
Private Sub Workbook_Open()
If MsgBox("Soll das Sichern der nicht gespeicherten Arbeitsmappen gestartet werden?" _
, vbYesNo + vbQuestion) = vbYes Then
Call Sichern_Start
End If
End Sub