VBA Excel - Boucle pour renommer plusieurs fichiers

Bonjour à tous,

Je suis à bout touchant dans l'élaboration de mon nouveau projet VBA en Excel.

Je bloque un peu sur une dernière fonction qui me permettra de renommer plusieurs fichiers se trouvant dans un répertoire déterminé.

Dans les détails, je crée un nouveau dossier si certains champs de mon userform sont modifiés et je souhaite déplacer l'ensemble des fichiers que contient l'ancien dossier dans le nouveau dossier et je souhaite aussi les modifier.

J'arrive à créer le nouveau dossier, déplacer les fichiers et supprimer l'ancien dossier vide.

Comment est-ce que je procède maintenant pour modifier l'ensemble des noms des fichiers ?

Pour information, tous mes fichiers se présentent sous cette nomenclature : Désignation du fichier (qui n'est pas fixe)_Nom de la personne (contenu dans une variable)_Prénom de la personne (contenu dans une variable)_Date de naissance (Contenu dans une variable).*.* => XXX_Nomclient_Prenomclient_Datenaissanclient.extension

La désignation du fichier pour chaque fichier doit donc être récupérée et les caractères après le premier _ modifiés en fonction des variables stockées.

Et je dois faire une boucle sur l'ensemble des fichiers pour les modifier :-D

Voici mon code

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51

If ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("C12").Value <> "" Then   Anneeavant_temp = Year(ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("CE12").Value) Moisavant_temp = Month(ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("CE12").Value) If Moisavant_temp = "1" Then Moislettreavant_temp = "01 Janvier" ElseIf Moisavant_temp = "2" Then Moislettreavant_temp = "02 Février" ElseIf Moisavant_temp = "3" Then Moislettreavant_temp = "03 Mars" ElseIf Moisavant_temp = "4" Then Moislettreavant_temp = "04 Avril" ElseIf Moisavant_temp = "5" Then Moislettreavant_temp = "05 Mai" ElseIf Moisavant_temp = "6" Then Moislettreavant_temp = "06 Juin" ElseIf Moisavant_temp = "7" Then Moislettreavant_temp = "07 Juillet" ElseIf Moisavant_temp = "8" Then Moislettreavant_temp = "08 Août" ElseIf Moisavant_temp = "9" Then Moislettreavant_temp = "09 Septembre" ElseIf Moisavant_temp = "10" Then Moislettreavant_temp = "10 Octobre" ElseIf Moisavant_temp = "11" Then Moislettreavant_temp = "11 Novembre" ElseIf Moisavant_temp = "12" Then Moislettreavant_temp = "12 Décembre" End If Dossiermoisavant = "C:\Users\jordanm\Desktop\Gestion INAD\14_R1" & "\" & Moislettreavant_temp & " " & Anneeavant_temp Dossierclientavant = Dossiermoisavant & "\" & Nomclientavant_temp & "_" & Prenomclientavant_temp & "_" & Datenaissanceavant_temp Nomclientavant_temp = ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("C12").Value Prenomclientavant_temp = ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("E12").Value Datenaissanceavant_temp = Format(ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("F12").Value, "ddmmyyyy")   If Not FSO.FolderExists(Dossiermois) Then Set fsoMonDossier = FSO.CreateFolder(Dossiermois) End If If Not FSO.FolderExists(Dossierclient) Then Set fsoMonDossier = FSO.CreateFolder(Dossierclient) End If FSO.CopyFile Dossierclientavant & "*.*", Dossierclient FSO.DeleteFolder Dossierclientavant             End If

---

D'avance merci pour votre aide et excellente journée.

Michael

Bonjour

déjà regarde du côté du case la prochaine fois que tu voudras écrire 12 if à la suite portant sur la même variable.
En l'occurrence essaye plutôt :

Code:

---

Moislettreavant_temp = format(ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("CE12").Value,"mm mmmm")

---

ça pourrait te faire gagner qq lignes de code.
Au passage assure-toi que c'est bien activeworkbook (le classeur actif) et pas thisworkbook (le classeur qui contient le code) que tu voulais écrire. C'est souvent le même mais prendre de bonnes habitudes t'évitera un jour peut-être de mauvaises surprises.

Après pour la boucle de rename ça doit ressembler à

Code:

---

1 2 3 4 5 6 7

Dim fld, fic Dim NouveauNom As String Set fld = fso.GetFolder(Dossierclient) For Each fic In fld.Files NouveauNom = "New_" & fic.Name fic.Name = NouveauNom Next fic

---

NouveauNom étant bien sûr à calculer suivant ton besoin...

Bonjour,

Merci pour le retour.

Je vais apporter les corrections nécessaires pour éviter les répétitions de IF. Merci pour le conseil.

Concernant la boucle pour renommer les fichier, j'essaie d'adapter ton code mais je n'arrive pas à récupérer les chaine de caractère de l'ancien nom de fichier pour monter le nouveau.

La boucle passe bien en revu la liste des fichiers du répertoire et me ressort par exemple :

Rapport final_Toto_Tata_01012000.docx

Je souhaite donc récupérer le texte avant le premier _ et l'extension pour pouvoir renommer le fichier correctement.

Voici ce que j'essaie :

Code:

---

1 2 3 4 5 6 7 8 9 10

Dim fld, fic Dim NouveauNom, NouveauNom2 As String Set fld = FSO.GetFolder(Dossierclient) For Each fic In fld.Files NouveauNom = fic.Name NouveauAvant = Left(NouveauNom, InStr(NouveauNom, "-") - 1) NouveauAprès = Right(NouveauNom, InStr(NouveauNom, ".") + 1) fic.Name = NouveauAvant & "_" & Nomclient_temp & "_" & Prenomclient_temp & "_" & Datenaissance_temp & "." & NouveauAprès Next fic

---

Et bien entendu ça bloque sur

Code:

---

1 2 3

NouveauAvant = Left(NouveauNom, InStr(NouveauNom, "-") - 1) NouveauAprès = Right(NouveauNom, InStr(NouveauNom, ".") + 1)

---

Je ne comprends pas bien comment fonctionne la manipulation des chaînes de caractère malgré les nombreuses informations que j'ai pu trouver sur internet.

D'avance merci pour le coup de main.

Michael.

Re,

1. tu nous montres des noms avec des "_" et tu cherches des '-' ...
2. le instr (".") va renvoyer la position du . donc le right doit se faire sur la longueur du nom - la position du .

Il faudra éventuellement après voir à rendre ça plus robuste au cas où :

Code:

---

1 2 3 4 5

I = instr(etc.) if i = 0 then ' signaler une erreur de nommage else ' continuer...

---

Bonjour,

Merci pour le retour.

Effectivement si je fais des erreurs, cela ne peut que poser des problèmes supplémentaires.

C'était la fin de journée, un peu déconcentré je vous avoue.

Par contre, même après avoir modifié, cela ne fonctionne toujours pas.

Code:

---

1 2	NouveauAvant = Left(NouveauNom, InStr(NouveauNom, "_", -1))

---

J'obtiens ce message d'erreur

Pièce jointe 639211

D'avance merci pour l'aide.

Michaeé.

Autant pour moi, je suis vraiment fatigué en cette fin de semaine.

Cela fonctionne :

Code:

---

1 2	NouveauAvant = Left(NouveauNom, InStr(NouveauNom, "_") - 1)

---

Je regarde pour corriger la seconde ligne.

Code:

---

1 2	NouveauApres = Right(NouveauNom, InStr(NouveauNom, ".") + 1)

---

Merci beaucoup.

Michael.

Bonjour

Courage,
je me corrige moi-même :

Citation:

---

le instr (".") va renvoyer la position du . donc le right doit se faire sur la longueur du nom - la position du .

---

ou plus simple utiliser mid sans para mètre de longueur (renvoie la fin de la chaine à partir de la position)

Code:

---

NouveauAprès = Mid(NouveauNom, InStr(NouveauNom, ".") + 1)

---

Bonjour,

Tout fonctionne parfaitement et je te remercie.

Les deux solutions avec RIGHT ou MID fonctionne parfaitement.

Merci beaucoup pour le coup de main.

Je mets mon code pour info si cela peut aider une autre personne.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32

If ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("C12").Value <> "" Then If ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("C12").Value <> TextBox100.Value Or ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("E12").Value <> TextBox102.Value Or ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("F12").Value <> TextBox103.Value Or ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("CE12").Value <> TextBox402.Value Then Anneeavant_temp = Year(ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("CE12").Value) Moisavant_temp = Month(ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("CE12").Value) Moislettreavant_temp = Format(ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("CE12").Value, "mm mmmm") Dossiermoisavant = "C:\Users\jordanm\Desktop\Gestion INAD\14_R1" & "\" & Moislettreavant_temp & " " & Anneeavant_temp Nomclientavant_temp = ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("C12").Value Prenomclientavant_temp = ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("E12").Value Datenaissanceavant_temp = Format(ActiveWorkbook.Worksheets("Datas dossiers personnels").Range("F12").Value, "ddmmyyyy") Dossierclientavant = Dossiermoisavant & "\" & Nomclientavant_temp & "_" & Prenomclientavant_temp & "_" & Datenaissanceavant_temp   If Not FSO.FolderExists(Dossiermois) Then Set fsoMonDossier = FSO.CreateFolder(Dossiermois) End If If Not FSO.FolderExists(Dossierclient) Then Set fsoMonDossier = FSO.CreateFolder(Dossierclient) End If FSO.CopyFile Dossierclientavant & "\" & "*.*", Dossierclient FSO.DeleteFolder Dossierclientavant   Set fld = FSO.GetFolder(Dossierclient) For Each fic In fld.Files NouveauNom = fic.Name On Error GoTo fin:: NouveauAvant = Left(NouveauNom, InStr(NouveauNom, "_") - 1) NouveauApres = Right(NouveauNom, (Len(NouveauNom) - InStr(NouveauNom, "."))) fic.Name = NouveauAvant & "_" & Nomclient_temp & "_" & Prenomclient_temp & "_" & Datenaissance_temp & "." & NouveauApres fin:: Next fic End If End If

---

Excellent weekend et merci encore.

Michael.

Bonjour,
Juste une remarque : InStr renvoie la position du premier caractère trouvé, dans votre cas le point qui précède l'extension du fichier, mais je vous conseille InStrRev qui renvoie la position du dernier caractère. Exemple avec un fichier de ce genre "XXX_Nom_Prenom.Xlsx" : si Nom est "TOTO.N.BELA" la fonction Instr ne va pas renvoyer la position de l'extension, alors que InStrRev le fera.
Ca n'a pas d'importance dans votre projet mais c'est à garder en mémoire pour vos prochains développements.
Cordialement.