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

Réponse 1 / 1
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
Posez votre question