XL 2016 Supprimer les fichiers plus vieux de 3 jours

[KTM]

Bonsoir Forum
Jai un dossier "Save" dans lequel j"enregistre des copies de sauvegarde de mon Fichier "Produit" à chaque enregistrement du fichier
selon le code :
Dim chemin$
chemin = ThisWorkbook.Path & "\Save\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin
ThisWorkbook.SaveCopyAs chemin & Format( Now, & ThisWorkbook.Name

Jaimerais supprimer a chaque sauvegarde les copies vielles de plus de 3 jours. Est ce possible? Merci.

 

[Efgé]

Bonjour KTM
La ligne :

ThisWorkbook.SaveCopyAs chemin & Format( Now, & ThisWorkbook.Name

est sensée faire quoi ?

sinon, regarde par ici


Cordialement

 

[job75]

Bonjour KTM, Efgé,

Placez dans ThisWorkbook :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim chemin$, fichier$, dat$, h$
chemin = ThisWorkbook.Path & "\Save\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin
ThisWorkbook.SaveCopyAs chemin & Format(Now, "yyyymmdd hhmmss ") & ThisWorkbook.Name
fichier = Dir(chemin & "*.xls*")
While fichier <> ""
    dat = Mid(fichier, 7, 2) & "/" & Mid(fichier, 5, 2) & "/" & Left(fichier, 4)
    h = Mid(fichier, 10, 2) & ":" & Mid(fichier, 12, 2) & ":" & Mid(fichier, 14, 2)
    dat = dat & " " & h
    If IsDate(dat) Then If Now - CDate(dat) > 3 Then Kill chemin & fichier
    fichier = Dir
Wend
End Sub

A+

 

[KTM]

Bonjour KTM, Efgé,

Placez dans ThisWorkbook :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim chemin$, fichier$, dat$, h$
chemin = ThisWorkbook.Path & "\Save\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin
ThisWorkbook.SaveCopyAs chemin & Format(Now, "yyyymmdd hhmmss ") & ThisWorkbook.Name
fichier = Dir(chemin & "*.xls*")
While fichier <> ""
    dat = Mid(fichier, 7, 2) & "/" & Mid(fichier, 5, 2) & "/" & Left(fichier, 4)
    h = Mid(fichier, 10, 2) & ":" & Mid(fichier, 12, 2) & ":" & Mid(fichier, 14, 2)
    dat = dat & " " & h
    If IsDate(dat) Then If Now - CDate(dat) > 3 Then Kill chemin & fichier
    fichier = Dir
Wend
End Sub

A+

Fantastique
Le temps de décortiquer ce sublime code ; juste vous dire que c'est super!!!!!