Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1468to1472
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Automatische Backup Datei

Automatische Backup Datei
14.01.2016 16:09:23
Imran
Hallo :)
Ich bin ziemlich unerfahren in der VBA Programmierung und benötige daher eure Hilfe.
Und zwar geht es darum, dass ich möchte dass alle zB 10 Minuten eine Backup-Datei meiner Excel Datei erstellt wird. Und das in einem separaten "Backup" Ordner.
Wichtig dabei ist, dass immer eine komplett neue Kopie erstellt werden soll. Das nimmt zwar sehr viel Speicher weg und bläht den Ordner unnötigerweise auf, aber das ist kein Problem für mich.
Der Dateiname soll dann den Dateinamen+Datum+Uhrzeit enthalten.
Ich habe hier in den archiven schon nachgeschaut, allerdings haben die Lösungen bei mir nicht funktioniert.
Ich hoffe ich bekomme es mit eurer Hilfe hin :)
Vielen Dank

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Automatische Backup Datei
14.01.2016 16:34:59
Sepp
Hallo Imran,
das geht so.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimer
End Sub

Private Sub Workbook_Open()
StartTimer
End Sub

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Public RunWhen As Double
Private Const cRunIntervalSeconds = 600 ' Intervall in Sekunden
Private Const cRunWhat = "Backup"

Sub Backup()
Dim strBackupPath As String, strFilename As String

strBackupPath = "E:\Forum\Backup" 'Verzeichnis für das Backup

If Right(strBackupPath, 1) <> "\" Then strBackupPath = strBackupPath & "\"

If MakeSureDirectoryPathExists(strBackupPath) <> 0 Then
  With ThisWorkbook
    strFilename = .Name
    strFilename = Left(strFilename, InStrRev(strFilename, ".") - 1) & _
      Format(Now, "_yyyyMMdd_hhmmss") & Mid(strFilename, InStrRev(strFilename, "."))
    .SaveCopyAs strBackupPath & strFilename
  End With
End If

StartTimer

End Sub

Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
  schedule:=True
End Sub

Sub StopTimer()
On Error Resume Next
Application.OnTime earliesttime:=RunWhen, _
  procedure:=cRunWhat, schedule:=False
End Sub

Achte darauf, welcher Code-Teil wohin gehört! Den Pfad für das Backup musst du anpassen!
Gruß Sepp

Anzeige
AW: Automatische Backup Datei
14.01.2016 16:59:51
Imran
Super, danke erstmal für den Code.
Beim schließen der Datei bekomme ich allerdings den "Mehrdeutiger Name: Workbook_Open" Fehler.
Soweit ich weiß entsteht der, weil nur ein "Workbook-Open" existieren darf.
Das ist der Code, den ich in MeineArbeitsmappe habe:
Option Explicit
Private avntOldValues As Variant
Private Sub Workbook_Open()
Call ReadValues
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call ReadValues
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call ReadValues
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim lngFirstFreeRow As Long
Dim rngCell As Range, rngRange As Range
If Sh.Name  "Protokoll" Then
Set rngRange = Intersect(Target, Sh.Range("A1:AP2000"))
If Not rngRange Is Nothing Then
'Ereignisbehandlung ausschalten:
Application.EnableEvents = False
With Worksheets("Protokoll")
lngFirstFreeRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
For Each rngCell In rngRange
If rngCell.Value  avntOldValues(rngCell.Row, rngCell.Column) Then
If avntOldValues(rngCell.Row, rngCell.Column)  "[PlatzhalterMakro -  _
NichtBeachten]" Then
.Cells(lngFirstFreeRow, 1).Value = Sh.Name
.Cells(lngFirstFreeRow, 2).Value = rngCell.Address(False, False)
.Cells(lngFirstFreeRow, 3).Value = rngCell.Value
.Cells(lngFirstFreeRow, 4).Value = avntOldValues(rngCell.Row,  _
rngCell.Column)
.Cells(lngFirstFreeRow, 5).Value = Date
.Cells(lngFirstFreeRow, 6).Value = Time
.Cells(lngFirstFreeRow, 7).Value = Environ("USERNAME")
lngFirstFreeRow = lngFirstFreeRow + 1
End If
End If
Next
End With
Set rngRange = Nothing
'Ereignisbehandlung wieder einschalten:
Application.EnableEvents = True
End If
End If
End Sub

Private Sub ReadValues()
avntOldValues = ActiveSheet.Range("A1:AP2000").Value
End Sub

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimer
End Sub

Private Sub Workbook_Open()
StartTimer
End Sub

Und ich bekomme einen Fehler beim kompilieren. Es soll wohl auf 64-Bit angepasst werden. Da wird mir dann die Function Zeile markiert.

Anzeige
AW: Automatische Backup Datei
14.01.2016 17:16:49
Sepp
Hallo Imran,
klar, steht doch auch in der Fehlermeldung! Du musst halt beide Makroaufrufe in ein Workbook_Open reinschreiben.
Gruß Sepp

AW: Automatische Backup Datei
14.01.2016 17:35:24
Imran
Stimmt, habe "StarTimer" jetzt oben in das erste Workbook_Open eingefügt. Der Fehler ist jetzt verschwunden !
Allerdings bleibt immernoch der, dass mein Code an 64-Bit angepasst werden muss.
"Fehler beim Kompilieren:
Der Code in diesem Projekt muss für die Verwendung auf 64-Bit System aktualisiert werden. Überarbeiten Sie Declare-Anweisungen, und markieren Sie mit dem PTRSafe-Attribut"
Und da markiert er mir "Function" in der 2. Zeile deines Codes

Anzeige
AW: Automatische Backup Datei
14.01.2016 17:42:45
Sepp
Hallo Imran,
soweit hab ich beim vorherigen Post gar nicht gelesen ;-))
Schmeiß die Deklaration in der zweiten zeile raus und ersetze sie durch den folgenden Code.
#If Win64 Then
Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As _
  String) As Long
#Else
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) _
  As Long
#End If

Gruß Sepp

Anzeige
AW: Automatische Backup Datei
14.01.2016 17:54:10
Imran
Auch dieser Fehler ist verschwunden ! Danke :)
Aber ein neuer ist leider aufgetreten...
"Nach End Sub , End Function oder End Property können nur Kommentare stehen"
und markiert mir diesen Part:
Private Sub ReadValues()
avntOldValues = ActiveSheet.Range("A1:AP2000").Value
End Sub

AW: Automatische Backup Datei
14.01.2016 17:56:45
Sepp
Hallo Imran,
dann hast du die Deklarationen nicht am Beginn des Modules stehen, sondern unterhalb der Prozeduren!
Gruß Sepp

Anzeige
AW: Automatische Backup Datei
14.01.2016 18:02:48
Imran
Und das bedeutet genau ? Entschuldige, dass ich Frage. Aber ich habe bis jetzt nur C++ gelernt. Bei VBA bin ich kompletter Neuling...
Muss ich hier irgendwas ändern ?
Option Explicit
Private avntOldValues As Variant
Private Sub Workbook_Open()
Call ReadValues
StartTimer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call ReadValues
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call ReadValues
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim lngFirstFreeRow As Long
Dim rngCell As Range, rngRange As Range
If Sh.Name  "Protokoll" Then
Set rngRange = Intersect(Target, Sh.Range("A1:AP2000"))
If Not rngRange Is Nothing Then
'Ereignisbehandlung ausschalten:
Application.EnableEvents = False
With Worksheets("Protokoll")
lngFirstFreeRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
For Each rngCell In rngRange
If rngCell.Value  avntOldValues(rngCell.Row, rngCell.Column) Then
If avntOldValues(rngCell.Row, rngCell.Column)  "[PlatzhalterMakro -  _
NichtBeachten]" Then
.Cells(lngFirstFreeRow, 1).Value = Sh.Name
.Cells(lngFirstFreeRow, 2).Value = rngCell.Address(False, False)
.Cells(lngFirstFreeRow, 3).Value = rngCell.Value
.Cells(lngFirstFreeRow, 4).Value = avntOldValues(rngCell.Row,  _
rngCell.Column)
.Cells(lngFirstFreeRow, 5).Value = Date
.Cells(lngFirstFreeRow, 6).Value = Time
.Cells(lngFirstFreeRow, 7).Value = Environ("USERNAME")
lngFirstFreeRow = lngFirstFreeRow + 1
End If
End If
Next
End With
Set rngRange = Nothing
'Ereignisbehandlung wieder einschalten:
Application.EnableEvents = True
End If
End If
End Sub

Private Sub ReadValues()
avntOldValues = ActiveSheet.Range("A1:AP2000").Value
End Sub

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimer
End Sub

Anzeige
AW: Automatische Backup Datei
14.01.2016 18:07:51
Sepp
Hallo Imran,
du hast 2 x 'Option Explicit' stehen, das mag der Kompiler natürlich nicht.
Das muss in der ersten Zeile stehen.
Gruß Sepp

AW: Automatische Backup Datei
14.01.2016 18:19:43
Imran
Hey, super !!
Bekomme jetzt keine Fehler mehr :)
Jetzt muss ich nur mal 10 min mit geöffneter Datei warten, ob eine Sicherung erstellt wird.
Vielen vielen Dank für deine Hilfe !
Ich "brauche" allerdings noch ein Makro, welches mir das aktuelle Datum im Format yyyy-mm-dd in Spalte D einträgt. Und es soll in die Zeile, in der irgendeine Art von Änderung geschieht !
Also zb in Zeile 2 wird in irgendeiner Spalte der Wert verändert. Wenn das passiert, soll in Spalte D das aktuelle Datum auftauchen

Anzeige
AW: Automatische Backup Datei
14.01.2016 18:19:43
Imran
Hey, super !!
Bekomme jetzt keine Fehler mehr :)
Jetzt muss ich nur mal 10 min mit geöffneter Datei warten, ob eine Sicherung erstellt wird.
Vielen vielen Dank für deine Hilfe !
Ich "brauche" allerdings noch ein Makro, welches mir das aktuelle Datum im Format yyyy-mm-dd in Spalte D einträgt. Und es soll in die Zeile, in der irgendeine Art von Änderung geschieht !
Also zb in Zeile 2 wird in irgendeiner Spalte der Wert verändert. Wenn das passiert, soll in Spalte D das aktuelle Datum auftauchen

AW: Automatische Backup Datei
14.01.2016 18:46:21
Imran
Ich erstelle einfach mal einen neuen Foreneintrag. Danke dir sehr für deine Hilfe !!!

Anzeige
AW: Automatische Backup Datei
14.01.2016 18:51:42
Sepp
Hallo Imran,
in das Modul der entsprechenden Tabelle.
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

On Error GoTo Errorhandler
Application.EnableEvents = False

If Target.Row > 1 Then
  For Each rng In Target
    Cells(rng.Row, 4) = Date
  Next
End If

Errorhandler:
Application.EnableEvents = True
End Sub

Gruß Sepp

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige