XL 2019 Limiter le nombre de mes sauvegardes.

BALANCIE

XLDnaute Junior
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
vite fait a l'arraché
voici une demo
VB:
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
demo.gif
 

BALANCIE

XLDnaute Junior
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
 

BALANCIE

XLDnaute Junior
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

XLDnaute Junior
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

XLDnaute Junior
vite fait a l'arraché
voici une demo
VB:
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
 

Discussions similaires

Réponses
2
Affichages
386

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
315 097
Messages
2 116 186
Membres
112 679
dernier inscrit
Yupanki