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

[BALANCIE]

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

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]

Bonjour Balancie,
A tester :

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]

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]

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

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]

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]

Bonjour

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

If a >= 3 Then Kill oldfich

 

[patricktoulon]

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

 

[sylvanu]

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

    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