Sicherungskopie einmal täglich

Hallo ihr Experten!
Ich habe ein Makro geschrieben, welches eine Sicherungskopie erstellt.
Da in der Datei 5 Leute arbeiten, würde ja die Sicherungskopie mit meinem Makro 4 x am Tag überschrieben werden.
Anbei das Makro:

Private Sub Workbook_Open()
MsgBox "Herzlich Willkommen zum Infotool 2.0.", vbOKOnly + vbInformation, "Infotool 2.0"
ActiveWorkbook.SaveCopyAs Filename:= _
("O:\DE-O-03\CTS_M\CTS_M_Production\01_AbwHG\AbwHG_06\Briefl._Matching\Infotool 2.0\ _
Sicherungskopien\" & "Sicherung  " & Format(Now, "dd-MM-yyyy") & ".xlsm")
End Sub

Ziel meines Makros ist es, dass beim ersten öffnen am Tag eine Sicherungskopie erstellt wird und keine weiteren.
Weiterhin soll automatisch die Sicherungskopie von vor eine Woche (also heute-7) gelöscht werden.
Kann man das Makro dahingehend erweitern oder ist das prinzipiell nicht möglich?
Danke euch.
MAX

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_Open() Dim name_ As String Dim name_old As String Dim today As String Dim lastWeek As String today = Format(Date, "dd-MM-yyyy") lastWeek = Format((Date - 7), "dd-MM-yyyy") name_ = "O:\DE-O-03\CTS_M\CTS_M_Production\01_AbwHG\AbwHG_06\Briefl._Matching\Infotool 2.0\" _ & _ "Sicherungskopien\Sicherung " & today & ".xlsm" If File_Exists(name_) Then Exit Sub ActiveWorkbook.SaveCopyAs Filename:=name_ name_old = "O:\DE-O-03\CTS_M\CTS_M_Production\01_AbwHG\AbwHG_06\Briefl._Matching\Infotool 2. _ 0\" & _ "Sicherungskopien\Sicherung " & lastWeek & ".xlsm" If File_Exists(name_old) Then Kill name_old End Sub Public Function File_Exists(ByVal File_Path As String) As Boolean If Dir(File_Path, vbDirectory) vbNullString Then File_Exists = True End Function

Private Sub Workbook_Open() Dim defaultName, name_new, name_old As String Dim today, lastWeek As String today = Format(Date, "dd-MM-yyyy") lastWeek = Format((Date - 7), "dd-MM-yyyy") defaultName = "O:\DE-O-03\CTS_M\CTS_M_Production\" & _ "01_AbwHG\AbwHG_06\Briefl._Matching\Infotool 2.0\" & _ "Sicherungskopien\Sicherung " name_new = defaultName & today & ".xlsm" name_old = defaultName & lastWeek & ".xlsm" If File_Exists(name_new) Then Exit Sub ActiveWorkbook.SaveCopyAs Filename:=name_new If File_Exists(name_old) Then Kill name_old End Sub Public Function File_Exists(ByVal File_Path As String) As Boolean If Dir(File_Path, vbDirectory) vbNullString Then File_Exists = True End Function

Dim Pfad$, Datei$ Pfad = "O:\DE-O-03\CTS_M\CTS_M_Production\01_AbwHG\AbwHG_06\" & _ "Briefl._Matching\Infotool 2.0\Sicherungskopien\" Datei = "Sicherung " & Format(Now, "dd-MM-yyyy") & ".xlsm" If Dir(Pfad & Datei) = "" Then ActiveWorkbook.SaveAs '... Datei = "Sicherung " & Format(Now - 7, "dd-MM-yyyy") & ".xlsm" Kill Pfad & Datei End If

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread