XL 2019 Comment mettre plusieurs répertoires dans ce code.

BALANCIE · 17 Mars 2023

Bonjour,
J'ai un code qui marche à merveille, ais j'aurai besoin de mettre les sauvegardes avec dates et limitations dans 2 répertoires supplémentaires et non dans le répertoire de travail.
Comment faire ?
Merci de votre aide.
BALANCIE

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

sylvanu · 17 Mars 2023

Bonjour Balancie,
A tester :

VB:

Sub savefichier()
    Dim chemin$, dat As Date, f, a&, oldfich$
    chemin1 = "C:\Users\PC_PAPA\Desktop\"
    chemin2 = "C:\Users\PC_PAPA\Desktop\XLD\"
    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 chemin1 & BaseName & "_" & Format(Now, "dd-mm-yyyy hh""H""mm""m""ss") & ".xlsm"
    ThisWorkbook.SaveCopyAs chemin2 & BaseName & "_" & Format(Now, "dd-mm-yyyy hh""H""mm""m""ss") & ".xlsm"
    ActiveWorkbook.Save
End Sub

BALANCIE · 17 Mars 2023

Bonjour Sylanu.
C'était aussi bête que cela. Quel idiot je suis.
Merci.

Cela dit cela fonctionne, mais maintenant la limitation dans les répertoires ne marche plus, alors que dans le premier cas cela s'exécute parfaitement.
J'ai fait un classeur rapidement avec les 2 cas.
Une idée. ?
BALANCIE.

sylvanu · 17 Mars 2023

Re,
Je n'ai pas fait attention aux limitations.
Pour faire simple on peut simplement dupliquer la macro avec les deux chemins :

VB:

Sub bonsave()
    Dim chemin1$, chemin2$, dat As Date, f, a&, oldfich$
    chemin1 = "C:\Users\PC_PAPA\Desktop\"       '"C:\Users\R-D\Pictures\Trav\Trav2\"
    chemin2 = "C:\Users\PC_PAPA\Desktop\XLD\"   '"C:\Users\R-D\Pictures\Trav\Trav1\"
    BaseName = "monfichier"
    dat = Now()
    
    ' Traitement Chemin1
    f = Dir(chemin1 & "monfichier*.xls*")
    a = 0
    Do While f <> ""
        a = a + 1
        fdt = CDate(FileDateTime(chemin1 & f))
        If f <> ThisWorkbook.Name Then If fdt < dat Then dat = CDate(fdt): oldfich = chemin1 & f
        f = Dir
    Loop
    If a >= 3 Then Kill oldfich
    ThisWorkbook.SaveCopyAs chemin1 & BaseName & "_" & Format(Now, "dd-mm-yyyy hh""H""mm""m""ss") & ".xlsm"
    
    ' Traitement Chemin2
    f = Dir(chemin2 & "monfichier*.xls*")
    a = 0
    Do While f <> ""
        a = a + 1
        fdt = CDate(FileDateTime(chemin2 & 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 chemin2 & BaseName & "_" & Format(Now, "dd-mm-yyyy hh""H""mm""m""ss") & ".xlsm"
    
    ' save current file
    ActiveWorkbook.Save
    Select Case MsgBox(" Les Sauvegardes sont réussies - ", , "Toutes les  Sauvegardes.")
    End Select
End Sub

BALANCIE · 17 Mars 2023

Bonsoir Sylanu.
Cela fonctionne en effet.
Mais une fois les 3 sauvegardes faites, à la quatrième j'ai une erreur à la ligne :Then Kill oldfich.
Merci encore pour l'aide, mais cela fait plusieurs jours que je suis dessus.
Je craque.. Cela me semblait pourtant tout simple.
BALANCIE.

Then Kill oldfich

Compte Supprimé 979 · 17 Mars 2023

Bonjour

Vous parlez de 4 sauvegardes, qu'est-ce qui est difficile de comprendre dans

VB:

If a >= 3 Then Kill oldfich

patricktoulon · 17 Mars 2023

re
bonjour à tous
et ouais!! il est parti d'un code à Patrick
ça va marcher beaucoup moins bien forcement

sylvanu · 17 Mars 2023

Re,
Ligne 26 il y a une coquille, essayez de mettre oldfich = chemin2 & f

VB:

    Do While f <> ""
        a = a + 1
        fdt = CDate(FileDateTime(chemin2 & f))
        If f <> ThisWorkbook.Name Then If fdt < dat Then dat = CDate(fdt): oldfich = chemin2 & f
        f = Dir
    Loop

XL 2019 Comment mettre plusieurs répertoires dans ce code.

BALANCIE

XLDnaute Junior

sylvanu

XLDnaute Barbatruc

BALANCIE

XLDnaute Junior

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

BALANCIE

XLDnaute Junior

Compte Supprimé 979

Guest

patricktoulon

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Discussions similaires