Renommer des fichiers dans plusieurs sous-répertoires

[FranckC]

Bonjour à la communauté,

Ce thème est largement abordé sur ce forum mais malgré toutes mes recherches je n'ai pas réussi à adapter les différentes solutions que j'ai pu trouver.

Je dispose de fichiers images (et autres formats) classés dans plusieurs sous-répertoires d'un même dossier. J'ai réussi à récupérer sur une feuille de calcul, dans des colonnes différentes : le chemin des sous-répertoires, le chemin des fichiers contenus dans chaque sous-répertoire et le nom des fichiers. J'ai également trouvé une macro permettant de renommer tous les fichiers d'un répertoire selon une liste de nom. Mon problème est que je souhaiterai adapter l'ensemble pour renommer l'ensemble des fichiers contenus dans les sous-répertoires en fonction d'une liste de correspondance que j'ai ajouté manuellement dans une nouvelle colonne.

Pour être plus précis, j'ai joint un fichier .xslm contenant l'ensemble des procédures permettant de lister le chemin des sous répertoire, le chemin des fichiers et le nom des fichiers tels que sauvegardés sur mon PC et la liste des nouveaux noms de fichiers que je souhaiterai attribuer.

1er Fichier joint : Liste_Fichiers_Images5.xlsm

Colonne A : Chemin Dossier (Liste le chemin complet de tous les sous-répertoire contenu dans le répertoire cible)

Colonne B : Chemin Fichier (Liste le chemin complet de tous les fichiers contenus dans tous les sous-répertoire du dossier cible)

Colonne C : Nom Fichier + extension (liste le nom des fichiers avec leur extension ; correspond également aux anciens noms de fichiers que je souhaiterai modifier). Actuellement, je récupère tous les fichiers. Est ce qu'il est possible de ne récupérer que les fichiers .jpg ?

Colonne D : Nouveau Nom Fichier (liste de correspondance des nouveaux noms de fichiers que je souhaiterai attribuer aux fichiers)

2eme Fichier joint : jb-ListeFichiersRepertoireRenomme.xls

Ce fichier me permet de renommer les fichiers contenus dans un répertoire, mais ce n'est pas pratique car cela nécessite de faire de nombreuses manipulations

J'espère avoir été assez précis pour vous permettre de m'apporter un peu d'aide. Je reste bien entendu à votre disposition pour toutes informations complémentaires et je vous remercie par avance pour toute l'aide que vous m'apporterez.

 

[sousou]

Bonjour
Pas sur d'avoir tout saisie dans ton contexte, mais le fichier joint placé dans un dossier, va lister tous les fichiers de tous les arboresences de tous le sous répertoire de ce dossier, dans la colonne(1) (utilisation de la récursivité), et la procédure renomme, va tous les renommer en fonctionn des valeur( nom de fichiers ) inclus dans la colonne(2)
Bien controler le bon fonctionnement (pas a pas) avant de lancer ce genre de renomage.

 

[Usine à gaz]

Bonjour Soussou, le Forum,

Bon dimanche à toutes et à toutes.

@Soussou,

Très intéressant ton code
mais ça beugue sur cette ligne :

Sub renomme()
n = 1
Set fso = CreateObject("scripting.filesystemobject")
k = ThisWorkbook.Sheets(1).Cells(n, 1)
While k <> ""
chemin = Left(k, InStrRev(k, "\"))
Set fich = fso.getfile(k)
If fich.Name <> ThisWorkbook.Sheets(1).Cells(n, 2).Value Then
fich.Name = ThisWorkbook.Sheets(1).Cells(n, 2).Value
End If

n = n + 1
k = ThisWorkbook.Sheets(1).Cells(n, 1)
Wend
End Sub

fich.Name = ThisWorkbook.Sheets(1).Cells(n, 2).Value

Amicalement,
arthour973

 

[sousou]

Bonjour
bien peux-tu me préciser le numéro d'erreur, est-ce qu'un fichier du même nom n'existerai pas...
valeur de n à ce moment, et valeur de fich.name, ou valeur de la cellule concernée
ou passe moi ton fichier

 

[Usine à gaz]

Bonjour,

Merci pour m'avoir répondu

Voici le fichier dans lequel j'ai mis une capture d'écran des fichiers à l'intérieur du dossier.

 

[sousou]

re
Oui mais c'est dans renomme que ca plante? pour que cela fonctionne, il faut que tu es des nom de fichier dans la colonne b

 

[Usine à gaz]

LOL suis bête

 

[Usine à gaz]

Dans le dossier, j'ai 4 fichiers.
Ton code n'en trouve que 3.
C'est normal ?

 

[sousou]

Qu'il ne se trouve pas lui_même c'est normal, mais lequel ne trouve t-il pas?

 

[sousou]

Modifie ainsi
Sub ftxt(r)
Set fichs = r.Files
For Each f In fichs
If f.Name <> ThisWorkbook.Name Then
ThisWorkbook.Sheets(1).Range("a1").Insert
ThisWorkbook.Sheets(1).Range("a1") = f.Path
End If
Next
End Sub

 

[sousou]

ou mieux
Sub ftxt(r)
Set fichs = r.Files
For Each f In fichs
If Right(f.Name, Len(ThisWorkbook.Name)) <> ThisWorkbook.Name Then
ThisWorkbook.Sheets(1).Range("a1").Insert
ThisWorkbook.Sheets(1).Range("a1") = f.Path
End If
Next
End Sub

 

[Usine à gaz]

C'est fait
C'est bon, il prend tout, même ton fichier ouvert.

mais ça bloque toujours là :
fich.Name = ThisWorkbook.Sheets(1).Cells(n, 2).Value

Je te joins le classeur.

 

[Usine à gaz]

J'ai pris ton second code :

Sub ftxt(r)
Set fichs = r.Files
For Each f In fichs
If Right(f.Name, Len(ThisWorkbook.Name)) <> ThisWorkbook.Name Then
ThisWorkbook.Sheets(1).Range("a1").Insert
ThisWorkbook.Sheets(1).Range("a1") = f.Path
End If
Next
End Sub

Il ne prend plus ton clsseur ouvert mais ça bloque tjrs là :
fich.Name = ThisWorkbook.Sheets(1).Cells(n, 2).Value

 

[sousou]

Oui mais là c'est dans renomme, alors as-tu mis des nom pour renommer dans la colonne b

 

[Usine à gaz]

OUI,

J'ai copié la colonne A en colonne B et modifié les noms des fichiers Comme ceci :
Col A :
C:\Users\lionel\Desktop\01 excel\Renomme_fichiers_soussou\Schopenhauer-L-art-d-avoir-toujours-raison.pdf
Col B :
C:\Users\lionel\Desktop\01 excel\Renomme_fichiers_soussou\Schopenhauer.pdf