excel - Create Backup folder with max. 7 backups -
my code doesnt kill older backups after getting on 7 backups :(
option explicit
private sub workbook_beforesave(byval saveasui boolean, cancel boolean)
dim savepath string
dim filename string
dim fileextension string
dim filedate string
dim filebackupname string
dim fileusername string
dim datei string
dim datalt string
dim dateilösch string
dim x long
dim zähler long
if dir(activeworkbook.path & "\" & "backup", vbdirectory) = "" then
mkdir (activeworkbook.path & "\" & "backup")
end if
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") '--- letztes backup löschen x = len(filename & "_" & fileusername & "_") + 1 datalt = "zzz" datei = dir(savepath & filename & "_" & fileusername & "_*." & fileextension) while datei <> "" zähler = zähler + 1 if mid(datei, x) < datalt datalt = mid(datei, x) dateilösch = datei end if datei = dir loop if zähler > 6 , datei <> "" kill savepath & dateilösch filebackupname = savepath & filename & "_" & fileusername & "_" & filedate & "." & "_" & _ fileextension activeworkbook.savecopyas filebackupname
end sub
thanks
Comments
Post a Comment