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

  • Initiateur de la discussion Initiateur de la discussion BALANCIE
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

BALANCIE

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

Pièces jointes

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
 

Pièces jointes

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
 
re
bonjour à tous
et ouais!! il est parti d'un code à Patrick
ça va marcher beaucoup moins bien forcement
diabolo.gif
 
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
418
Réponses
12
Affichages
1 K
Retour