Supprimer les fichiers les plus anciens

Bonjour,

je cherche en VBA à supprimer dans un répertoire donné les fichiers les plus anciens, pour ne garder que les 5 plus récents.

Voila ou j'en suis dans mes recherches, si vous avez une idée merci de m'aider ...

Option Explicit

Sub enreg_auto()

Dim dossier As String, Fichier As String

dossier = "E:\mariage\"
Fichier = "mariage" & "_" & Year(Date) & "-" & Month(Date) & "-" & Day(Date) & "_" & Hour(Time) & Minute(Time) & ".xlsm"

ChDir dossier
ActiveWorkbook.SaveAs Filename:=dossier & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

If NbFich(dossier, "xls") > 5 Then
    MsgBox "plus que 5"
    End If
'MsgBox ActiveWorkbook.BuiltinDocumentProperties(11)
'Kill dossier & "mariage_2015-8-17_1548" & ".xlsm"

'ActiveWorkbook.Close
End Sub

Function NbFich(Chemin As String, ParamArray Termin() As Variant) As Long

Dim Fichier As String
Dim Extension As Variant
Dim Compteur As Long

For Each Extension In Termin
   Fichier = Dir(Chemin & "\*." & Extension)
   Do Until Fichier = ""
   Compteur = Compteur + 1
   Fichier = Dir
   Loop
Next Extension

NbFich = Compteur
End Function

Bonjour,

Alors pour ma part je n'y connais rien

Maintenant j'avais eu besoin dans le passé de retrouver les 2 fichiers les plus récents dans un dossier... Eriiic m'avait fait une macro qui fonctionne super bien. Si tu es plus calée que moi tu pourras peut-être l'adapter pour avoir les 5 plus récents...

Tu trouveras la macro en page 2 :

https://forum.excel-pratique.com/excel/retrouver-le-fichier-le-plus-recent-t63321-10.html?hilit=récent

Bonne journée,

VBABEGINNER

Ah oui ça me semble pas mal, merci je vais regarder ça de près !

Merci pour l'aide j'ai réussi en modifiant légèrement, voici le code au cas ou :

Sub enreg_auto()

'Déclaration des variables
Dim dossier As String, ancien_fichier As String, fichier As String, chemin 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
dossier = "E:\mariage\"
If Right(dossier, 1) <> "\" Then dossier = dossier & "\"

'définition des variables
fichier = "mariage" & "_" & Year(Date) & "-" & Month(Date) & "-" & Day(Date) & "_" & Hour(Time) & Minute(Time) & ".xlsm"
chemin = dossier & fichier
ancien_fichier = Dir(dossier & "*mariage*" & "*.xls*", vbNormal)

'Selectionne le doosier et sauvegarde
ChDir dossier
ActiveWorkbook.SaveAs Filename:=chemin, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

     Do While Len(ancien_fichier) > 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(dossier & ancien_fichier)
            listFich(2, idx) = ancien_fichier

           'Prend le prochain fichier dans le dossier
           ancien_fichier = 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 5 plus récent
            idx_max = Application.WorksheetFunction.Max(idx)
            For idx = 5 To idx_max
                If idx_max > 5 Then
                Kill dossier & listFich(2, idx_max)
                End If
                idx_max = Application.WorksheetFunction.Max(idx)
            Next idx

Application.Quit

End Sub