Workbook_BeforeClose garde que 3 dernier fichiers

Bonjour,

J'ai fait un code qui m'enregistre chaque fois quand je ferme le fichier une copie du fichier avec la date dans un dossier Backup, le code marche impeccable, il fait ce qu'on lui demande.

La question est comment je puisse garde que trois dernier fichiers dans ce répertoire Backup, en clair faire une purge automatique en gardent que 3 dernier fichier.

Mon code :

 Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Chemin As String, Fichier As String, sDateTime As String, sFileName As String

Chemin = ThisWorkbook.Path & Application.PathSeparator & "Backup" & Application.PathSeparator
Fichier = ThisWorkbook.Name
With ThisWorkbook
        sDateTime = " (" & Format(Now, "yyyy-mm-dd hhmm") & ").xlsm"
        sFileName = Application.WorksheetFunction.Substitute _
          (Chemin & Fichier, ".xlsm", sDateTime)
        .SaveCopyAs sFileName
    End With

    End Sub

Merci pour aide

Est-ce que quelqu'un peut me dire si ce code est bien :

 Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'Déclaration des variables

    Dim chemin As String, fichier As String, sDateTime As String, sFileName As String
    Dim idx As Long, listFich() As Variant, fini As Boolean, idx_max As Integer
    ReDim listFich(1 To 2, 1 To 1), tmp(2)

    'Choix du dossier de Backup
chemin = ThisWorkbook.Path & Application.PathSeparator & "Backup" & Application.PathSeparator
fichier = ThisWorkbook.Name

With ThisWorkbook
        sDateTime = " (" & Format(Now, "yyyy-mm-dd hhmm") & ").xlsm"
        sFileName = Application.WorksheetFunction.Substitute _
          (chemin & fichier, ".xlsm", sDateTime)
        .SaveCopyAs Filename:=sFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

    End With

  Do While Len(sFileName) > 0

            'Assigne la date du ficier en cours une date/heure dans une variable
          idx = idx + 1
            ReDim Preserve listFich(1 To 2, 1 To idx)
            listFich(1, idx) = FileDateTime(sFileName)
            listFich(2, idx) = asFileName

           'Prend le prochain fichier dans le dossier
          sFileName = Dir

        Loop

        'trie par dates décroissantes
           Do
            fini = True
            For idx = 1 To UBound(listFich, 2) - 1
                If listFich(1, idx) < listFich(1, idx + 1) Then
                    tmp(1) = listFich(1, idx)
                    tmp(2) = listFich(2, idx)
                    listFich(1, idx) = listFich(1, idx + 1)
                    listFich(2, idx) = listFich(2, idx + 1)
                    listFich(1, idx + 1) = tmp(1)
                    listFich(2, idx + 1) = tmp(2)
                    fini = False
                End If
             Next idx
        Loop Until fini

            'supprime les fichiers trop ancien en ne gardant que les 3 plus récent
           idx_max = Application.WorksheetFunction.Max(idx)
            For idx = 3 To idx_max
                If idx_max > 3 Then
                Kill sFileName & listFich(2, idx_max)
                End If
                idx_max = Application.WorksheetFunction.Max(idx)
            Next idx

    End Sub

Merci

J'ai une erreur ici :

'Prend le prochain fichier dans le dossier
          sFileName = Dir

Voici le code qui marche pour ceux qui cherchent la même chose que moi :

 Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'Déclaration des variables

    Dim chemin As String, fichier As String, sDateTime As String, sFileName As String, MonFichier As String
    Dim idx As Long, listFich() As Variant, fini As Boolean, idx_max As Integer
    ReDim listFich(1 To 2, 1 To 1), tmp(2)

    'Choix du dossier de Backup
chemin = ThisWorkbook.Path & Application.PathSeparator & "Backup" & Application.PathSeparator
fichier = ThisWorkbook.Name

With ThisWorkbook
        sDateTime = " (" & Format(Now, "yyyy-mm-dd hhmm") & ").xlsm"
        sFileName = Application.WorksheetFunction.Substitute _
          (chemin & fichier, ".xlsm", sDateTime)
        .SaveCopyAs sFileName

    End With

     'Prend le premier fichier depuis le dossier de Backup
   MonFichier = Dir(chemin & "*.xls", vbNormal)
'MonFichier = Dir(sFileName, vbNormal)

     Do While Len(MonFichier) > 0

            'Assigne la date du ficier en cours une date/heure dans une variable
          idx = idx + 1
            ReDim Preserve listFich(1 To 2, 1 To idx)
            listFich(1, idx) = FileDateTime(chemin & MonFichier)
            listFich(2, idx) = MonFichier

           'Prend le prochain fichier dans le dossier
          MonFichier = Dir

        Loop

        'trie par dates décroissantes
           Do
            fini = True
            For idx = 1 To UBound(listFich, 2) - 1
                If listFich(1, idx) < listFich(1, idx + 1) Then
                    tmp(1) = listFich(1, idx)
                    tmp(2) = listFich(2, idx)
                    listFich(1, idx) = listFich(1, idx + 1)
                    listFich(2, idx) = listFich(2, idx + 1)
                    listFich(1, idx + 1) = tmp(1)
                    listFich(2, idx + 1) = tmp(2)
                    fini = False
                End If
             Next idx
        Loop Until fini

            'supprime les fichiers trop ancien en ne gardant que les 3 plus récent
           idx_max = Application.WorksheetFunction.Max(idx)
            For idx = 3 To idx_max
                If idx_max > 3 Then
                Kill chemin & listFich(2, idx_max)
                End If
                idx_max = Application.WorksheetFunction.Max(idx)
            Next idx

    End Sub