Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Créer une discussion
  • 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 !

S'inscrire

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
 
Trier par date Trier par votes
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
 
Vote positif 0 Vote négatif
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

Vote positif 0 Vote négatif
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

Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

D
  • Question Question
XL 2019 3 repertoires
Réponses
2
Affichages
433
DANIELRAG
D
  • Question Question
Microsoft 365 Conserver la valeur de ma variable pour l'utiliser dans un autre code
Réponses
3
Affichages
455
mapomme
  • Question Question
XL 2021 Accélérer la copie du classeur actif faite par vba
2 3 4
Réponses
45
Affichages
3 K
Usine à gaz
  • Résolu(e)
XL 2021 Faire une copie de mon classeur quand "Target" change
2 3
Réponses
30
Affichages
3 K
Usine à gaz
F
  • Résolu(e)
XL 2019 Enregistrer sous la feuille active dans répertoire du fichier père en vba
2
Réponses
23
Affichages
2 K
Fabrice16ct
F
P
  • Résolu(e)
XL 2019 Petit détail concernant la sauvegarde automatique
Réponses
2
Affichages
942
pierrelcq
P
P
  • Question Question
XL 2019 Sauvegarde automatique
Réponses
1
Affichages
1 K
youky(BJ)
M
  • Question Question
XL 2013 Copier plusieurs onglets vers un autre classeur
2
Réponses
27
Affichages
3 K
MCMAL
M
L
  • Résolu(e)
XL 2013 RECUPARATION FICHIER PDF
Réponses
2
Affichages
921
laurentsicli
L
  • Résolu(e)
XL 2010 Erreur d'execution '13' : type incompatible (Résolu)
Réponses
8
Affichages
2 K
jeje77
T
  • Question Question
Modification code VBA
Réponses
12
Affichages
1 K
Minick
M
T
  • Question Question
Aide pour améliorer mon code
Réponses
7
Affichages
1 K
teamtat
T
  • Question Question
Sauvegarder 1 feuil dans un Dossier Zip
Réponses
2
Affichages
1 K
MuscatMimi
  • Question Question
Ligne de Code qui Bug sous Word
Réponses
0
Affichages
860
MuscatMimi
C
  • Question Question
archiver dans repertoire selon restrictions jour et temps
Réponses
1
Affichages
1 K
CAPRI_456
C
  • Question Question
Erreur 1004 macro avec bandeau excel
Réponses
4
Affichages
3 K
tactic6
M
[REF] Wiki 5 de MichelXld (Formules, Audits de formules, Répertoires, Fichiers)
Réponses
0
Affichages
47 K
MichelXld
M
M
[REF] Wiki 2 de MichelXld (Ce qui touche aux UserForm)
Réponses
0
Affichages
116 K
MichelXld
M
M
[REF] Wiki 1 de MichelXld (Généralités Excel)
Réponses
6
Affichages
60 K
Le_Phénomène
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…