XL 2019 Renommer en masse les titres de colonne des .CSV

Amilo · 12 Novembre 2022

Bonjour le forum,

J'ai un dossier "CSV Test" contenant 2 sous-dossiers "2021" et "2022".
Dans chaque sous-dossier se trouvent des dossiers mensuels "01", "02", "03"...dans lequel j'ai un fichier au format .csv

J'aimerais svp remplacer dans tous les fichiers sources, les 5 titres des colonnes :

Par exemple : Mois,Lieu,Article,Quantités,Montant,Code par Date,Ville,Marchandise,Quantités,Vente,Référence

En vous remerciant par avance

Cordialement

patricktoulon · 13 Novembre 2022

tiens la lecture est en utf-8 cette fois ci
0.007 secondes pour modifier tout ton dossier

VB:

Option Explicit

Const oldChaine As String = "Mois,Lieu,Article,Quantités,Montant,Code"


Const NewChaine As String = "Date,Ville,Marchandise,Quantités,Vente,Référence"

Sub choix_dossier()
    Dim Dossier
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then Dossier = .SelectedItems(1)
        If Dossier = "" Then Exit Sub
    End With
    replaceAllCsvHeader Dossier
MsgBox " Remplacement du Header dans les CSVs terminé"
End Sub

Function replaceAllCsvHeader(Dossier)
    Dim FsO As Object, fich, x&, subdossier, contenu As String
 
    Set FsO = CreateObject("Scripting.FileSystemObject")
    Set Dossier = FsO.GetFolder(Dossier)
     For Each fich In Dossier.Files
      
        'lecture
        With CreateObject("ADODB.Stream")
            .Charset = "utf-8": .Open: .LoadFromFile (fich): contenu = .ReadText()
        End With
          'ecriture
        x = FreeFile: Open fich For Output As #x: Print #x, Replace(contenu, oldChaine, NewChaine): Close #x
    Next
     For Each subdossier In Dossier.subfolders
        replaceAllCsvHeader subdossier.Path
    Next subdossier
    Set FsO = Nothing

End Function

@sylvanu tu veux bien tester ?

Amilo · 13 Novembre 2022

merci @patricktoulon ,

patricktoulon à dit:
dans tout les cas ils vont te poser probleme
peut etre vaudrais il mieux les remastériser avant de les mofifier

patricktoulon à dit:
mais je suis pas étonné
avec quoi ils on été générés ces csv ?

Pour répondre à votre questions et à votre remarque :

Les .csv sont des fichiers que j'avais téléchargés sur le net dans un exercice sur power query,
Comme il s'agit d'un simple exercice et concernant un éventuel problème, je ne vais pas plus loin que des manipulations dans power query.

Edit : oups je viens de voir votre précédent message, je vais tester également, merci

Cordialement

sylvanu · 13 Novembre 2022

Re,
@patricktoulon
Je pense pourtant avoir fait la bonne manip.
Mais après test,
1- L' entête n'est pas modifiée avec la nouvelle chaine ( qui doit commencer par Date,Ville... )
2- le "é" de quantités est remplacé par "?"

patricktoulon · 13 Novembre 2022

re
avec le nouveau code ?tu n'apas le replace ??????
et oui alors le bom a bien été supprimé mais subsiste quelques caractères invisibles dans notepad
vraiment bizarre ces fichiers moitié utf-8 moitié ansi

peut être réécriture en utf-8 pour rester dans le ton des fichiers

après si 3 pc différents interprètent le fichier différemment c'est un vrai problème

sylvanu · 13 Novembre 2022

patricktoulon à dit:
avec le nouveau code ?

Ben oui !

patricktoulon · 13 Novembre 2022

ok ben on reste en utf-8 alors

VB:

Option Explicit

Const oldChaine As String = "Mois,Lieu,Article,Quantités,Montant,Code"


Const NewChaine As String = "Date,Ville,Marchandise,Quantités,Vente,Référence"

Sub choix_dossier()
    Dim Dossier
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then Dossier = .SelectedItems(1)
        If Dossier = "" Then Exit Sub
    End With
    replaceAllCsvHeader Dossier
    MsgBox " Remplacement du Header dans les CSVs terminé"
End Sub

Function replaceAllCsvHeader(Dossier)
    Dim FsO As Object, fich, x&, subdossier, contenu As String

    Set FsO = CreateObject("Scripting.FileSystemObject")
    Set Dossier = FsO.GetFolder(Dossier)
    For Each fich In Dossier.Files

        'lecture
        With CreateObject("ADODB.Stream")
            .Charset = "utf-8": .Open: .LoadFromFile (fich): contenu = .ReadText()
        End With
        
        'ecriture
        With CreateObject("ADODB.Stream")
            .Type = 2: .Charset = "utf-8": .Open: .WriteText Replace(contenu, oldChaine, NewChaine)
            .SaveToFile fich, 2
        End With
    
    Next
    For Each subdossier In Dossier.subfolders
        replaceAllCsvHeader subdossier.Path
    Next subdossier
    Set FsO = Nothing

End Function

sylvanu · 13 Novembre 2022

Re,
La conversion se fait correctement, sans les guillemets.
Par contre j'ai un souci.
Si je lance sur ce dossier j'ai cette erreur:

( les fichiers sont sous CSV Test\2021\01 )

Par contre si je lance un niveau en dessous alors c'est ok.

J'ai l'impression qu'il n'analyse qu'à un niveau en dessous.

patricktoulon · 13 Novembre 2022

hum..... je vais voir
mais normalement c'est recursif

patricktoulon · 13 Novembre 2022

non chez moi tout le dossier maître et ses deux dossiers ainsi que leur sous dossiers sont bien visités

patricktoulon · 13 Novembre 2022

regarde dans la console si tout les noms de fichiers ressorte

VB:

Option Explicit

Const oldChaine As String = "Mois,Lieu,Article,Quantités,Montant,Code"


Const NewChaine As String = "Date,Ville,Marchandise,Quantités,Vente,Référence"

Sub choix_dossier()
    Dim Dossier
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then Dossier = .SelectedItems(1)
        If Dossier = "" Then Exit Sub
    End With
    replaceAllCsvHeader Dossier
    MsgBox " Remplacement du Header dans les CSVs terminé"
End Sub

Function replaceAllCsvHeader(Dossier)
    Dim FsO As Object, fich, x&, subdossier, contenu As String

    Set FsO = CreateObject("Scripting.FileSystemObject")
    Set Dossier = FsO.GetFolder(Dossier)
    For Each fich In Dossier.Files

       debug.print fich
    
    Next
    For Each subdossier In Dossier.subfolders
        replaceAllCsvHeader subdossier.Path
    Next subdossier
    Set FsO = Nothing

End Function

Amilo · 13 Novembre 2022

Re,

sylvanu à dit:
Par contre si je lance un niveau en dessous alors c'est ok.
Regarde la pièce jointe 1155189
J'ai l'impression qu'il n'analyse qu'à un niveau en dessous.

J'ai le même résultat que sylvanu, cela fonctionne lorsque je prends un niveau inférieur à savoir le dossier "01" par exemple
Il y a les nouveaux titres et les lignes sans guillemets.

Cordialement

patricktoulon · 13 Novembre 2022

ben ca alors

vous êtes sur de ne pas avoir la scripting en vrac

patricktoulon · 13 Novembre 2022

re
essayez de mettre un doevents entre la lecture et l’écriture

Amilo · 13 Novembre 2022

@patricktoulon ,

Cela fonctionne également lorsque je sélectionne tout le répertoire "2021", cela opère bien les modifications dans tous les fichiers mensuels (testé avec votre code du message #21)
Lorsque je sélectionne le dossier maître "CSV Test", je reçois le message d'erreur évoqué par sylvanu dans son message #22,

Edit : finalement, en plaçant le fichier .xlsm en dehors du dossier "CSV Test", cela a très bien fonctionné pour l'ensemble des sous-dossiers.
Probablement que cette information m'avait échappé au départ.

Merci à vous, sylvanu et patricktoulon,
Vos 2 solutions répondent à ma demande, une avec les guillemets et une autre sans les guillemets

Bon dimanche à tous

Cordialement

patricktoulon · 13 Novembre 2022

a ben c'est sur si vous choisissez le zip pour folder on va avoir un problème de récursivité
et pour cause (et c'est normal) on se retrouve dès le 2d avec un "fich" avec deux fois le debut de l'adresse du fichier
si vous voulez garrder le dossier dans le zip dans les ressources j'ai placé une fonction dir récursive dans les fichiers zip

XL 2019 Renommer en masse les titres de colonne des .CSV

Amilo

XLDnaute Accro

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Amilo

XLDnaute Accro

sylvanu

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Amilo

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Amilo

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

Discussions similaires