Macro pour renommer les fichiers contenus dans des sous-dossiers [Fermé]

Signaler
-
Messages postés
16433
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
15 avril 2021
-
Bonjour,

Je viens de recevoir des données qui sont très mal fichues :
Il y a les dossiers "année" de 2004 à 2016...
Dans chaque dossier "année", il y a des centaines de sous-dossiers "jours" (notés par ex : "18 juin")... Dans chacun de ces sous-dossiers, il y a 6 fichiers "CSV", notés "Tableau X" de (1 à 6)
Question : quelqu'un pourrait-il m'aider à faire une macro qui compil les noms du dossier "année" avec celui du dossier "jour" pour ensuite renommer tous les fichiers CSV avec la syntaxe "Tableau 1 20161124" pour le Tableau 1 du 24 novembre 2016 ?

Si vous avez des idées, je précise que je suis sous Excel 2013

Merci d'avance pour votre aide :-)

1 réponse

Messages postés
16433
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
15 avril 2021
3 164
Bonjour,

Non testé
, si problème merci de m'envoyer 1 ou 2 fichiers.csv
Mettre lefichier sans données confidentielles en pièce jointe sur « mon-partage.fr »
et faire un clic droit-coller le raccourci dans votre message



le code
Option Explicit
'---------------------------------------------------------------
Function Nouveau_nom(Fich As String)
Dim Separe, Jour As String, Mois As String, Annee As String
Dim Liste_mois, Num_mois As String

'transformation du nom de ficjier format jjmmmmaaaa en aaaammjj
'sépare les éléments du nom de fichier
Separe = Split(Fich)
Jour = Format(Separe(2), "00")
Mois = LCase(Separe(3))
'détermination du numéro de mois avec nom de mois sans accent "é" et majuscule
If Mois = "février" Or Mois = "décembre" Then: Mois = Replace(Mois, "é", "e")
Liste_mois = Array("janvier", "fevrier", "mars", "avril", "mai", "juin", "juillet", "aout", "septembre", "octobre", "novembre", "decembre")
Num_mois = Format(Application.Match(Mois, Liste_mois, 0), "00")
Annee = Left(Separe(4), 4)

Nouveau_nom Annee & Num_mois & Jour & ".csv"
End Function
'-----------------------------------------------------------------------------------
Sub renommer_fichier()
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim Chemin As String, Fich As String

Application.ScreenUpdating = False
'dossier voulu
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
Chemin = oFolderItem.Path
If Chemin = "" Then Exit Sub

ChDir Chemin 'dossier des fichiers csv
Fich = Dir("*.csv")
While Fich <> ""
Name Fich As Nouveau_nom(Fich)
Fich = Dir
Wend
End Sub



 Michel