Suppression backup auto

Bonjour,

ma base de donnée excel me fait une sauvegarde à chaque fermeture en prenant comme nom de fichier

sNomSave = sNomSave & "_" & Format(Now, "yyyymmdd-hhnnss") & "." & sExtension

je me retrouve avec des noms de fichier:

DocExcel_20200306-094235

ceci étant dit je dois supprimer les anciennes sauvegardes à la main dans mon dossier backup

j'aimerais donc désormais pouvoir supprimer les versions supérieures à avant hier..

a priori on peut utiliser le fonction kill

mais comment l'appliquer pour qu'elle s'applique au fichiers concernés?

merci

bonjour,

Fournir la totalité des macros qui se trouvent dans le ThisWorkbook SVP

A+

Voici

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim sRepSave As String 'répertoire de sauvegarde
    Dim sExtension As String
    Dim sNomSave As String 'nom de la sauvegarde
    Dim lErr As Long
    Dim sErr As String
    Dim Save_Status As String

    Save_Status = Sheets("Dashboard").Range("T7")

    'indiquer ici le répertoire de sauvegarde
    sRepSave = "C:\Users\User\Desktop\TBD Projets\Backups\"
    If Save_Status = "Yes" Then
    'vérifie répertoire existe
    If Dir(sRepSave, vbDirectory) = "" Then
        MsgBox "Répertoire de sauvegarde absent !" & vbCrLf & sRepSave, vbExclamation
    Else
        sExtension = Split(ThisWorkbook.Name, ".")(UBound(Split(ThisWorkbook.Name, ".")))
        'nom de la sauvegarde
        sNomSave = Replace(ThisWorkbook.Name, "." & sExtension, "")
        sNomSave = sNomSave & "_" & Format(Now, "yyyymmdd-hhnnss") & "." & sExtension

        'sauvegarde copie
        On Error Resume Next
        ThisWorkbook.SaveCopyAs sRepSave & sNomSave
        lErr = Err.Number
        sErr = Err.Description
        On Error GoTo 0

        If lErr <> 0 Then
            MsgBox "Erreur de lors de la copie !" & vbCrLf & "Err n°" & lErr & vbCrLf & sErr, vbExclamation
        End If
    End If
    End If
    ThisWorkbook.Save

End Sub

Bonjour,

Cette macro supprime tous les fichiers datant de plus de 3 jours qui se trouvent dans le dossier indiqué (Quelque soit leur nom)

Private Sub DelOldFile()
Dim s$, sWay$, i%, delai%
delai = 3 'jours
sWay = "C:\Users\User\Desktop\TBD Projets\Backups\"
s = Dir(sWay & "")
Do While Not Len(s) = 0
   i = i + 1
      If FileDateTime(sWay & s) < Date - delai Then Kill sWay & s
   s = Dir
Loop
End Sub

Tu pourrais la mettre dans ThisWorkbook et l'appeler au début ou à la fin du :

Private Sub Workbook_Open()
   DelOldFile
End Sub

A+

parfait merci je vais tester

Pas parfait ! Une petite erreur corrigée :

If FileDateTime(sWay & s) < Date - delai Then Kill sWay & s

A+