Hallo TommyK,
der folgende Code archiviert das Backend im Unterverzeichnis \"Backups\" des original Dateipfades der original Backend-Datei mit dem Datumszusatz.
Bei einer zweiten Archivierung am selben Tag wird die Datei NICHT noch einmal gespeichert und auch die Archivierung NICHT mehr durchgeführt. Liegt das an der \"If Dir(Zieldatei)\"-Schleife?
'=======================================================================
'= Backup erstellen und nicht \"aktuell\"e Daten archivieren und löschen =
'=======================================================================
Private Sub Archivieren_Click()
On Error GoTo Err_Archivieren_Click
' Backup erstellen im Unterpfad \"\Backups\\" mit Speicherdatum
Dim sConnect As String, Zieldatei As String, oFSO As Variant
Dim l As Integer
sConnect = CurrentDb.TableDefs(\"[color=#FF0000]Deine_Tabelle[/color]\"«»).Connect
l = InStr(1, sConnect, \"=\"«»)
sConnect = Mid(sConnect, l + 1)
Zieldatei = Left(sConnect, Len(sConnect) - [color=#008000]10[/color]) & \"Backups\\" & \"[color=#825900]Deine_Datenbank[/color]_\" & _
Year(Now) & \"_\" & Month(Now) & \"_\" & Day(Now) & \".mdb\"
If Dir(Zieldatei) = \"\" Then
Set oFSO = CreateObject(\"Scripting.FileSystemObject\"«»)
oFSO.CopyFile sConnect, Zieldatei, True
'SetAttr Zieldatei, vbReadOnly
MsgBox \"Es wurde eine Sicherheitskopie unter \" & _
Zieldatei & \" erstellt\"
End If
' Nicht \"aktuell\"e Daten archivieren und löschen
DoCmd.SetWarnings False
DoCmd.OpenQuery \"Daten_archivieren\", acNormal, acEdit
DoCmd.OpenQuery \"Archivierte_Daten_löschen\", acNormal, acEdit
DoCmd.SetWarnings True
Exit_Archivieren_Click:
Exit Sub
Err_Archivieren_Click:
MsgBox Err.Description
Resume Exit_Archivieren_Click
End Sub
Deine_Tabelle = eine verlinkte Tabelle
10 = Anzahl der Buchstaben von Dateiname plus \".\" plus Endung
Deine_Datenbank = Name der original Datenbank (ohne \".\" und Endung)
Herzlichen Dank für die Hilfe.
Gruß
Adolf