XL 2019 Limiter le nombre de mes sauvegardes.

BALANCIE · 2 Mars 2023

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 · 2 Mars 2023

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 · 2 Mars 2023

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

BALANCIE · 2 Mars 2023

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 · 2 Mars 2023

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 · 2 Mars 2023

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 · 2 Mars 2023

BALANCIE à dit:
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 · 2 Mars 2023

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 · 2 Mars 2023

re
a la bonne heure

dysorthographie · 2 Mars 2023

Bonjour,
Tu peux utiliser Guitlab!

BALANCIE · 7 Mars 2023

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

BALANCIE · 16 Mars 2023

patricktoulon à dit:
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

XL 2019 Limiter le nombre de mes sauvegardes.

BALANCIE

XLDnaute Junior

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

BALANCIE

XLDnaute Junior

patricktoulon

XLDnaute Barbatruc

BALANCIE

XLDnaute Junior

BALANCIE

XLDnaute Junior

BALANCIE

XLDnaute Junior

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

BALANCIE

XLDnaute Junior

BALANCIE

XLDnaute Junior

Discussions similaires