XL 2019 Limiter le nombre de mes sauvegardes.

[BALANCIE]

Bonjour à tou (te)s.

Actuellement je sauvegarde mon classeur à 3 endroits différents.
Le premier (l'original) sans date ni heure.
Les autres ( les saves) avec la date et l'heure. Cela me permet en cas de problèmes de revenir en arrière.
Je cherche un code VBA afin de limiter à 2 où 3 copies maxi dans les dossiers Saves. de manière qu'à chaque nouvelle sauvegarde le nombre de 2 où 3 soit permanent ce qui veut dire que les plus anciens sauront effacés automatiquement.
Comment faire. ?

Juste pour info voici le code utilisé actuellement :

Sub LesSaves()
'UpdateByExtendoffice20160623
ActiveWorkbook.SaveCopyAs "D:\DOSSIER\TOTO\TRUC\GESTIONS \GEST23\Save\" + ActiveWorkbook.Name
ActiveWorkbook.SaveCopyAs "D:\DOSSIER\TOTO\TRUC\GEST \GEST23\" & Format(Now, "dd-mm-yyyy hh""H""mm") + ActiveWorkbook.Name
ActiveWorkbook.SaveCopyAs "E:\DOSSIER\TOTO\TRUC\GEST23\Save\" & Format(Now, "dd-mm-yyyy hh""H""mm") + ActiveWorkbook.Name
ActiveWorkbook.Save


Merci de votre aide et de vos conseils.
BALANCIE

 

[patricktoulon]

re
le plus simple derait un nom avec la date sur un certain format
tester avec dir si il y a 3 fichier avec dans le nom la base du nom fichier
si oui supprimer celui qui a le fidatetime le plus vieux
et save nom+date+heure
de cette manière tu aurais toujours les 3 derniers

 

[patricktoulon]

vite fait a l'arraché
voici une demo

Sub savefichier()
    Dim chemin$, dat As Date, f, a&, oldfich$
    chemin = ThisWorkbook.Path & "\"
    BaseName = "monfichier"
    dat = Now()
    f = Dir(chemin & "monfichier*.xls*")
    Do While f <> ""
        a = a + 1
        fdt = CDate(FileDateTime(chemin & f))
        If f <> ThisWorkbook.Name Then If fdt < dat Then dat = CDate(fdt): oldfich = chemin & f
        f = Dir
    Loop
    If a >= 3 Then Kill oldfich
    ThisWorkbook.SaveCopyAs chemin & BaseName & "_" & Format(Now, "dd-mm-yyyy hh""H""mm""m""ss") & ".xlsm"
    ActiveWorkbook.Save
End Sub

comme tu peux le voir ci dessous tu a toujours les 3 derniers
il faut juste qu'il y est au moins une seconde d'attente en deux enregistrements

 

[BALANCIE]

Bonjour,
Merci pour le retour.

J'ai essayé mais si le code fonctionne cela ne change rien à mon problème. Les saves s'accumulent.
Je précise que je ne suis pas bon dans le codage VBA et j'ai sans aucun doute loupé un truc.
Merci pour votre aide, j'apprécie.
BALANCIE.

Voilà ce que j'ai fais :

Sub savefichier()
Dim chemin$, dat As Date, f, a&, oldfich$
chemin = ThisWorkbook.Path & "\"
BaseName = "Gest23"
dat = Now()
f = Dir(chemin & "Gest23*.xlms*")
Do While f <> ""
a = a + 1
fdt = CDate(FileDateTime(chemin & f))
If f <> ThisWorkbook.Name Then If fdt < dat Then dat = CDate(fdt): oldfich = chemin & f
f = Dir
Loop
If a >= 3 Then Kill oldfich

ActiveWorkbook.SaveCopyAs "D:\DOSSIER\TOTO\TRUC\GESTIONS \GEST23\Save\" + ActiveWorkbook.Name
ActiveWorkbook.SaveCopyAs "D:\DOSSIER\TOTO\TRUC\GEST \GEST23\" & Format(Now, "dd-mm-yyyy hh""H""mm") + ActiveWorkbook.Name
ActiveWorkbook.SaveCopyAs "E:\DOSSIER\TOTO\TRUC\GEST23\Save\" & Format(Now, "dd-mm-yyyy hh""H""mm") + ActiveWorkbook.Name
ActiveWorkbook.Save

End Sub

 

[patricktoulon]

re
tu peux m'expliquer pourquoi tu le fait 3 fois
je t'ai donné un code qui fonctionne arrange le pour les noms de dossiers ect.... et c'est bon
tu la bien vu dans la capture non? tu a toujours les deux dernière versions + l'original

 

[BALANCIE]

Re-bonjour,

Pourquoi 3 fois. Je dois transmettre une copie pour un autre service et je tient à garder dans un dossier "secours" la trace. Le dernier où premier plutôt est la bas d'origine sur lequel on travail ( celui sans heure et date).
Je vais regarder de nouveau le fichier, j'ai du faire une mauvaise manip.
Merci encore du coup de main, j'apprécie.
Bonne soirée.
BALANCIE

 

[BALANCIE]

Re-bonjour,

Pourquoi 3 fois. Je dois transmettre une copie pour un autre service et je tient à garder dans un dossier "secours" la trace. Le dernier où premier plutôt est la bas d'origine sur lequel on travail ( celui sans heure et date).
Je vais regarder de nouveau le fichier, j'ai du faire une mauvaise manip.
Merci encore du coup de main, j'apprécie.
Bonne soirée.
BALANCIE

 

[BALANCIE]

Bonsoir.
J'ai trouvé l'erreur de frappe de ma part.
Le code marche à merveille. C'est exactement ce que je recherchais.
Grand merci du coup de main.
Très bonne soirée.
BALANCIE

 

[patricktoulon]

re
a la bonne heure

 

[dysorthographie]

Bonjour,
Tu peux utiliser Guitlab!

 

[BALANCIE]

Merci pour l'info. Très intéressant.
Balancie.

 

[BALANCIE]

vite fait a l'arraché
voici une demo

Sub savefichier()
    Dim chemin$, dat As Date, f, a&, oldfich$
    chemin = ThisWorkbook.Path & "\"
    BaseName = "monfichier"
    dat = Now()
    f = Dir(chemin & "monfichier*.xls*")
    Do While f <> ""
        a = a + 1
        fdt = CDate(FileDateTime(chemin & f))
        If f <> ThisWorkbook.Name Then If fdt < dat Then dat = CDate(fdt): oldfich = chemin & f
        f = Dir
    Loop
    If a >= 3 Then Kill oldfich
    ThisWorkbook.SaveCopyAs chemin & BaseName & "_" & Format(Now, "dd-mm-yyyy hh""H""mm""m""ss") & ".xlsm"
    ActiveWorkbook.Save
End Sub

comme tu peux le voir ci dessous tu a toujours les 3 derniers
il faut juste qu'il y est au moins une seconde d'attente en deux enregistrements
Regarde la pièce jointe 1164640

Bonjour,
Encore merci pour l'aide donné.
Ce code fonctionne.
Mais j'aurai besoin que les sauvegardes avec la date heure etc.. soient installées dans 2 répertoires différents.
A savoir : Le premier sous : monfichier.xlsm ( ici c'est parfait).
Le deuxième : dans un autre répertoire par ex: dossierSave avec date heure etc limité à 3.
Le troisième : dans un autre répertoire par ex : dossierUsb avec date heure etc limité à 3.
J'ai essayé sans succès à trouver la solution, mais je suis nul en Vba.
Comment faire pour adapter ce code.
Merci.
BALANCIE