Sicherungskopie per VBA

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 = "(Sicherungspfad)" 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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Chris,
kann man z.B. wie folgt lösen.
Gruß
Franz

Private Sub Workbook_Open()
Dim defaultName As String, name_new As String
Dim today As String
today = Format(Date, "dd-MM-yyyy")
defaultName = "(Sicherungspfad)"
defaultName = Me.Path & "\SK\" & Left(Me.Name, InStrRev(Me.Name, ".") - 1)
name_new = defaultName & today & ".xlsm"
If File_Exists(name_new) Then Exit Sub
Me.SaveCopyAs Filename:=name_new
Call Kill_Old_File(name_new)
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
Public Sub Kill_Old_File(sFileNew, Optional maxSK As Integer = 5)
'Anzahl Sicherheitskopien prüfen, älteste ggf. löschen
'sFileNew muss wie folgt aufgebaut sein (Datum steht vor der Namenserweiterung): _
Pfad\DateinameTT-MM-JJJJ.dateierweiterung
Dim sPfad As String, sName As String
Dim intJ As Integer, arrFiles()
Dim sDatum As String, datMin As Date, intMin As Integer
Dim sDatei As String
'aus Namen Verzeichnis und Dateiname ermitteln
sPfad = Left(sFileNew, InStrRev(sFileNew, "\"))
sName = Mid(sFileNew, InStrRev(sFileNew, "\") + 1)
'im Verzeichnis nach den Dateinamen mit verschiedenen Datumswerten suchen
sDatei = Dir(sPfad & Left(sName, InStrRev(sName, ".") - 11) & "*" _
& Mid(sName, InStrRev(sName, ".")))
datMin = Date
Do Until sDatei = ""
'Datum aus dem Dateinamen schneiden
sDatum = Mid(sDatei, InStrRev(sDatei, ".") - 10, 10)
'Datum in eine Form umsetzen, die von CDate umgewandelt werden kann
sDatum = Right(sDatum, 4) & "-" & Mid(sDatum, 4, 2) & "-" & Left(sDatum, 2)
If IsDate(sDatum) Then
intJ = intJ + 1
ReDim Preserve arrFiles(1 To intJ)
arrFiles(intJ) = sDatei
'prüfen des Datums im Dateinamen auf ältestetes(kleinstest)
If CDate(sDatum)  maxSK Then
VBA.Kill (sPfad & arrFiles(intMin))
End If
End Sub

Hallo Chris,
wie schon geschrieben: Ich hab das Makro getestet und es funktioniert mit meinem Wert für defaultName.
Den Wert im Code in deiner Frage kann ich nicht bewerten.


defaultName = "(Sicherungspfad)"

Der Wert sollte (besser muss) den kompletten Pfad der Sicherungskopie enthalten plus den Namen der Datei vor dem anzufügenden Datum.


defaultName = Me.Path & "\SK\" & Left(Me.Name, InStrRev(Me.Name, ".") - 1)

In meinem Beispiel werden die Sicherungskopieen in einem Unterverzeichnis des Ordners gespeichert in dem die Datei gespeichert ist. Der Dateiname ist gleich dem der Original-Datei.
Da bei dir der Speichervorgang nicht funktioniert ist mit dem neuen Namen irgend etwas faul. Entweder der Pfad oder der Dateiname.
Gruß
Franz

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread