Supprimer les fichiers les plus anciens
l
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
V
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 :
Bonne journée,
VBABEGINNER
l
Ah oui ça me semble pas mal, merci je vais regarder ça de près !
l
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