Limiter le nombre de fichiers dans un dossier

bonjour,

je viens vers vous car je bloque (je suis nul )

j'aimerai limiter à 6 le nombre de fichier dans un dossier.

en effet, je crée des copies d'un fichier source dans un dossier ("temp"), mais pour éviter d'avoir dans 1mois 1000 fichiers, je souhaiterai limiter à 6 le nombre de copies en suppriment les plus anciennes.

merci d'avance à vous

cdt

jb

Va voir la macro, elle est a adapter a ton cas

elle ne garde que les 6 fichiers les plus récents et sauvegarde automatiquement le fichier en cours

Naturellement tous tes fichiers devront contenir cette Procédure

Toukoul

bonjour,

merci à vous Toukoul pour le code.

j'ai essayé de le modifier pour le mettre dans le fichier mais petit problème il ne supprime pas les fichiers

je pense que cela viens de moi dans la réécriture du code.

si une bonne âme pourrait jeter un oeil un grand merci à vous

Sub SauvTempo()

Application.DisplayAlerts = False

'créer une sauvegarde avant la lecture seule

Dim Path_name As String

Dim File_name As String

Dim File_name1 As String

Dim Complete_File_name As String

Dim DossierPrincipal As String

Dim ancien_fichier 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

Path_name = ThisWorkbook.Path

DossierPrincipal = Path_name & "\" & " temp"

If Len(Dir(DossierPrincipal, vbDirectory)) > 0 Then

'le dossier principale existe

' le dossier principale n'exite pas

Else

'creation du dossier principale

MkDir Path_name & "\" & " temp"

End If

'creation du nom de sauvegarde

File_name = "132_RIC_PLANIFICATION " & "lecture"

File_name1 = File_name & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xlsm"

Complete_File_name = DossierPrincipal & "\" & File_name1

ancien_fichier = Dir(DossierPrincipal & "* temp*" & "*.xlsm*", vbNormal)

'enresgistre sous..

ActiveWorkbook.SaveCopyAs Filename:=Complete_File_name

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(Complete_File_name & 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 6 plus récent

idx_max = Application.WorksheetFunction.Max(idx)

For idx = 6 To idx_max

If idx_max > 6 Then

Kill Complete_File_name & listFich(2, idx_max)

End If

idx_max = Application.WorksheetFunction.Max(idx)

Next idx

end sub

cdt

merci à vous

jb

Envoie le fichier, c'est beaucoup plus rapide pour nous, pense à ceux qui veulent t'aider ils ne veulent pas passer leur temps à recréer l'environnement de chaque nouveau venu

Encore merci de nous comprendre

bonjour à tous

merci pour ta réponse et encore désolé

je te joins le fichier

merci encore

cdt

jb

Bonjour,

comme ce sont des sauvegardes indépendentes du fichier principal, tu peux les nommer 132_RIC_PLANIFICATION 0 à 132_RIC_PLANIFICATION 5 et tourner dessus.

Tu mets dans une feuille paramètre le n° du dernier utilisé.

Le suivant sera (Range("A2") + 1) MOD 6

La date et l'heure tu la lis sur l'explorateur de fichier.

eric

bonjour eric

sans vouloir abuser de votre temps.

est il possible de m'expliquer un peu plus à partir du code.

je comprends l'idée mais la transformer en code cela est plus dure

merci à vous pour votre aide

cdt

jb

re,

j'ai trouver

merci à vous tous

cdt

jb

Voici ma version :

Sub SauvTempo()
    Const nbCopie As Long = 6
    Dim fich As String, copie As String
    Application.DisplayAlerts = False
    'créer une sauvegarde avant la lecture seule
    ' n° copie
    Worksheets("Params").[A2] = (Worksheets("Params").[A2] + 1) Mod nbCopie
    ' chemins & noms
    fich = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    copie = ThisWorkbook.Path & "\temp\" & ThisWorkbook.Name
    copie = Left(copie, Len(copie) - 5) & "_" & Worksheets("Params").[A2] & ".xlsm"
    ' backup
    ActiveWorkbook.SaveAs Filename:=copie, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ' enregistrer et revenir à l'original
    ActiveWorkbook.SaveAs Filename:=fich, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

eric