Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1656to1660
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

Maximal 5 Sicherungskopien

Maximal 5 Sicherungskopien
11.11.2018 18:07:05
Ray
Hallo Community,
vielleicht kann einer mir weiterhelfen.
https://www.herber.de/forum/archiv/1492to1496/1493469_Maximal_5_Sicherungskopien.html#1493473
Hier im forum Archiv habe ich einen Code zum Speichern von Sicherungskopien gefunden, der selbständig das 6 älteste Backup Löschen soll.
Ich habe den Code entsprechend angepasst bei dem punkt SavePath = ....
Und die Sicherungskopie funktioniert auch gut. Nur wird kein altes Backup Gelöscht.
Habe ich irgendetwas übersehen? Muss noch etwas angepasst werden?
Ich hoffe jemand kann mir weiterhelfen?! Da dieses feature schon echt nett ist.
Vielleicht sehe ich auch einfach nur den Wald vor lauter Bäumen nicht.
Vielen Dank und noch einen schönen Sonntag euch
Ray

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Maximal 5 Sicherungskopien
11.11.2018 20:19:13
Sepp
Hallo Ray,
im VBE unter 'Extras' > 'Verweise' den verweis auf die 'Microsoft Scripting Runtime' setzen!
Microsoft Excel Objekt DieseArbeitsmappe
Option Explicit 
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
  Dim SavePath As String, FileName As String, FileExtension As String 
  Dim FileDate As String, FileBackupName As String, FileUsername As String 
  Dim strFile As String, lngCount As Long, objDic As New Scripting.Dictionary 
 
  SavePath = ThisWorkbook.Path & "\Backup\" 
  FileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) 
  FileExtension = Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") + 1) 
  FileUsername = Environ("UserName") 
  FileDate = Format(Now, "YYYYmmdd_hhmmss") 
   
 
  strFile = Dir(SavePath & "*" & FileUsername & "*" & FileExtension, vbNormal) 
   
  Do While strFile <> "" 
    objDic.Add Key:=FileDateTime(SavePath & strFile), Item:=SavePath & strFile 
    strFile = Dir 
  Loop 
 
  If objDic.Count > 5 Then 
    Set objDic = SortDictionaryByKey(objDic, xlDescending) 
    For lngCount = 5 To objDic.Count - 1 
      Kill objDic.Items(lngCount) 
    Next 
  End If 
      
 
  FileBackupName = SavePath & FileName & "_" & FileUsername & "_" & FileDate & "." & FileExtension 
  ActiveWorkbook.SaveCopyAs FileBackupName 
End Sub 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Modul Modul1
Option Explicit 
 
Public Function SortDictionaryByKey(dict As Object _
  , Optional sortorder As XlSortOrder = xlAscending) As Object 
  '© https://excelmacromastery.com/vba-dictionary/ 
  Dim arrList As Object 
  Set arrList = CreateObject("System.Collections.ArrayList") 
     
  ' Put keys in an ArrayList 
  Dim Key As Variant, coll As New Collection 
  For Each Key In dict 
    arrList.Add Key 
  Next Key 
     
  ' Sort the keys 
  arrList.Sort 
     
  ' For descending order, reverse 
  If sortorder = xlDescending Then 
    arrList.Reverse 
  End If 
     
  ' Create new dictionary 
  Dim dictNew As Object 
  Set dictNew = CreateObject("Scripting.Dictionary") 
     
  ' Read through the sorted keys and add to new dictionary 
  For Each Key In arrList 
    dictNew.Add Key, dict(Key) 
  Next Key 
     
  ' Clean up 
  Set arrList = Nothing 
  Set dict = Nothing 
     
  ' Return the new dictionary 
  Set SortDictionaryByKey = dictNew 
         
End Function 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Maximal 5 Sicherungskopien
11.11.2018 20:56:56
Ray
Hallöchen Sepp,
Danke, werde ich umgehend testen und mich melden.
Darf ich noch fragen, was das zweite Makro (Modul Modul1) bewirkt?
Schönen Abend
Ray
AW: Maximal 5 Sicherungskopien
11.11.2018 21:06:16
Sepp
Hallo Ray,
wie der Name der Funktion verrät, dient es zum Sortieren des Dictionaries.
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Maximal 5 Sicherungskopien
12.11.2018 11:04:55
Ray
Hallo nochmal,
inzwischen konnte ich den Code testen und leider bekomme ich eine Fehlermeldung.
Der heist:
"Laufzeitfehler 53: Datei nicht gefunden"
und Gelb Markiert wird diese Zeile:
objDic.Add Key:=FileDateTime(SavePath & strFile), Item:=SavePath & strFile
Solange der Ziel Ordner noch Leer ist läuft die Makro ohne Meldung und es wird auch eine Sicherungskopie erstellt.
Aber sobald sich die erste Sicherungskopie im Ordner befindet, kommt die "Laufzeitfehler 53" Meldung.
Und es wird auch keine weitere Sicherungskopie erstellt.
Weist du vielleicht woran das liegen könnte?
Vielen Dank
Ray
Anzeige
AW: Maximal 5 Sicherungskopien
12.11.2018 17:32:24
Sepp
Hallo Ray,
habe den Code bei mir getestet und läuft tadellos!
Nur das 6 anstatt 5 Kopien behalten werden, siehe Code unten, der Code im allgemeinen Modul bleibt unverändert.
Hast du etwas am Code bzw. an der Erstellung des dateinamens geändert?
Microsoft Excel Objekt DieseArbeitsmappe
Option Explicit 
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
  Dim SavePath As String, FileName As String, FileExtension As String 
  Dim FileDate As String, FileBackupName As String, FileUsername As String 
  Dim strFile As String, lngCount As Long, objDic As New Scripting.Dictionary 
  
  Const clngCopiesToKeep As Long = 5  'Anzahl der zu behaltenden Sicherungskopien 
   
  SavePath = ThisWorkbook.Path & "\Backup\" 
  FileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) 
  FileExtension = Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") + 1) 
  FileUsername = Environ("UserName") 
  FileDate = Format(Now, "YYYYmmdd_hhmmss") 
    
  strFile = Dir(SavePath & "*" & FileUsername & "*" & FileExtension, vbNormal) 
    
  Do While strFile <> "" 
    objDic.Add Key:=FileDateTime(SavePath & strFile), Item:=SavePath & strFile 
    strFile = Dir 
  Loop 
  
  If objDic.Count > clngCopiesToKeep - 1 Then 
    Set objDic = SortDictionaryByKey(objDic, xlDescending) 
    For lngCount = clngCopiesToKeep - 1 To objDic.Count - 1 
      Kill objDic.Items(lngCount) 
    Next 
  End If 
       
  FileBackupName = SavePath & FileName & "_" & FileUsername & "_" & FileDate & "." & FileExtension 
  ActiveWorkbook.SaveCopyAs FileBackupName 
End Sub 
 
 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Maximal 5 Sicherungskopien
12.11.2018 19:00:42
Ray
Guten Abend Sepp,
Am Allgemeinen Modul habe ich nichts geändert.
Im Code für "DieseArbeitsmappe" habe ich nur den SafePath = angepasst.
Wenn mein Pfad D:\System\Verein\Backup ist, wie soll der den in der Zeile aussehen.
SavePath = ThisWorkbook.Path & "\Backup\"
Nicht das ich dort ein Fehler gemacht habe.
Dankeschön
Grüße
Ray
AW: Maximal 5 Sicherungskopien
12.11.2018 19:16:02
Sepp
Hallo Ray,
SavePath = "D:\System\Verein\Backup\"
der abschließende Backslash ist wichtig!
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Maximal 5 Sicherungskopien
12.11.2018 19:36:29
Ray
Hallo Sepp,
Genauso habe ich das auch gemacht.
Komisch... Weil das ist der einzige Punkt den ich entsprechend geändert habe.
Ich werde das nochmal Testen und mich melden.
Schönen Abend noch
Ray
AW: Maximal 5 Sicherungskopien
13.11.2018 20:05:34
Ray
Hallo Sepp,
Ich wollte mich nochmal ganz herzlich bei Dir bedanken.
Ich habe heute nochmal mit dem Code gearbeitet und was soll ich sagen, funktioniert nun tadellos!
Vielen vielen Dank Sepp.
LG
Ray
AW: Maximal 5 Sicherungskopien
13.11.2018 20:17:22
Sepp
Hallo Ray,
freut mich, dass es klappt.
Hier noch eine Version die ohne Zusatzfunktion und ohne Verweis auf die Scripting-Runtime funktioniert.
Microsoft Excel Objekt DieseArbeitsmappe
Option Explicit 
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
  Dim SavePath As String, FileName As String, FileExtension As String 
  Dim FileDate As String, FileBackupName As String, FileUsername As String 
  Dim strFile As String, lngCount As Long, dblCheckTime As Double 
  Dim varDate() As Variant 
   
  Const clngCopiesToKeep As Long = 5  'Anzahl der zu behaltenden Sicherungskopien 
   
  SavePath = ThisWorkbook.Path & "\Backup\" 
  FileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) 
  FileExtension = Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".")) 
  FileUsername = Environ("UserName") 
  FileDate = Format(Now, "YYYYmmdd_hhmmss") 
  FileBackupName = SavePath & FileName & "_" & FileUsername & "_" & FileDate & FileExtension 
   
  strFile = Dir(SavePath & "*" & FileName & "*" & FileUsername & "*" & FileExtension, vbNormal) 
    
  Do While strFile <> "" 
    Redim Preserve varDate(lngCount) 
    varDate(lngCount) = CDbl(FileDateTime(SavePath & strFile)) 
    lngCount = lngCount + 1 
    strFile = Dir 
  Loop 
  
  If lngCount > clngCopiesToKeep - 1 Then 
    dblCheckTime = Application.Large(varDate, clngCopiesToKeep - 1) 
    strFile = Dir(SavePath & "*" & FileName & "*" & FileUsername & "*" & FileExtension, vbNormal) 
    Do While strFile <> "" 
      If CDbl(FileDateTime(SavePath & strFile)) < dblCheckTime Then 
        Kill SavePath & strFile 
      End If 
      strFile = Dir 
    Loop 
  End If 
       
  ActiveWorkbook.SaveCopyAs FileBackupName 
End Sub 
 
 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Maximal 5 Sicherungskopien
13.11.2018 20:30:35
Ray
Danke danke,
Dann werde ich mal prüfen was sich besser verträgt.
Danke nochmal
Ray

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige