Convertir plusieurs fichiers CSV UTF 8 en fichiers XLSX
J'ai besoin de votre aide pour convertir tous les fichiers CSV avec séparateur pont-virgule et encodage UTF 8 vers le format XLSX.
J'étais tout content car j'avais trouvé comment transformé mes fichiers CSV en XLSX mais je n'ai pas pris en compte l'encodage UTF 8 ce qui me donne des caractères spéciaux quand j'ouvre le fichier XLSX.
Je pense qu'il doit y avoir un ".TextFilePlatform = 65001" à placer quelque part ou passer par l'intermédiaire d'un fichier texte mais j'ai vraiment besoin d'une solution svp.
D'avance merci pour votre aide
Voici mon code s'il peut aider ci-dessous si cela peut aider:
Const sExtension As String = "csv"
Const sNewExtension As String = "xlsx"
Const TypeFichier = "csv"
Dim sDossier As String
Dim FSO As Object
Dim Dossier As Object
Dim sFichier As String, F As String
Dim Pos As Long, i As Long, sExt As String
Dim TFichier() As String
Dim sNom As String
sDossier = ThisWorkbook.Path
Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = FSO.GetFolder(sDossier)
TFichier = Split(TypeFichier, ";")
sFichier = Dir$(sDossier & "\*.*")
Do While Len(sFichier) > 0
F = FSO.GetFileName(sFichier)
For i = LBound(TFichier) To UBound(TFichier)
If UCase(sFichier) <> UCase(ThisWorkbook.Name) Then
Pos = InStr(F, TFichier(i))
sExt = FSO.GetExtensionName(F)
If Pos > 0 And UCase(sExt) = UCase(sExtension) Then
sNom = Left$(F, Len(F) - Len(sExt))
Workbooks.Open Filename:=sDossier & "\" & sFichier, local:=True
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=sDossier & "\" & sNom & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Nb = Nb + 1
End If
End If
Next i
sFichier = Dir$()
Application.StatusBar = Nb
Loop
' If bSousDossier Then
' For Each Dossier In Dossier.SubFolders
' ChangerExtensionFichiers Dossier.Path, True
' Next Dossier
'End If
Application.ScreenUpdating = True
Set Dossier = Nothing
Set FSO = Nothing
End Sub
Bonjour
Le plus simple est de passer par PowerQuery intégré à Excel avec éventuellement quelques lignes de VBA pour délier le résultat de la source
Hello,
Oui j'ai des exemple mais là je suis sûr que c'est de l'UTF8 car j'ai fait des tests. (Les caractères accentués ne passent pas par exemple)
Pour la solution de Power Query ça me semble bien pour rassembler les données dans un même fichier Excel. Par contre dans mon cas je n'ai pas trouvé comment faire car les fichiers n'ont pas toujours le même nom ni le même nombre de colonnes.
Et il faut bien que chaque fichier soit transformé en fichier Excel.
Est-il possible de combiner VBA et Power Query?
Proposition (non testée car pas de fichier utf8)
Option Explicit
Sub importer()
Dim chemin$, Rep As FileDialog
' choix du répertoire
Set Rep = Application.FileDialog(msoFileDialogFolderPicker)
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire des fichiers ..."
Rep.Show
If Rep.SelectedItems.Count = 0 Then Exit Sub
chemin = Rep.SelectedItems(1) & "\"
' effacement et préparation
Cells.Clear
Range("A1").Select
' chemin, separateur (; par défaut), debut (1 par défaut), entetes (True par défaut)
importCSV chemin
End Sub
Sub importCSV(chemin As String, Optional sep As String = ";", Optional debut As Integer = 1, Optional entetes As Boolean = True)
' sep est le séparateur , ou ; ou vbTab
' debut caractérise la première ligne du fichier csv à importer
' entetes indique s'il faut importer les en-têtes se trouvant sur la ligne début
Dim fichier$, T() As String, D, ligne&, i%, ContenuLigne$, nItems%
fichier = Dir(chemin & "*.csv")
Do While fichier <> ""
Open chemin & fichier For Input As #1
ligne = 1
Do While Not EOF(1)
Line Input #1, ContenuLigne
T = Split(ContenuLigne, sep)
nItems = UBound(T) + 1
If ligne >= debut Then
If ligne = debut Then ReDim D(1 To nItems, 1 To 1)
If ligne > debut Then ReDim Preserve D(1 To nItems, 1 To ligne - debut + 1) ' Preserve ne permet de redimensionner que la dernière dimension d'un tableau avec conservation des données
For i = 0 To UBound(T)
' si date : effectuer permutation jour et mois
D(i + 1, ligne - debut + 1) = Utf8_Decode(T(i))
Next i
End If
ligne = ligne + 1
Loop
Close #1
D = Application.Transpose(D)
If ligne - debut = 1 Then
Selection.Resize(1, UBound(D)) = D ' cas d'une seule ligne dans le fichier csv
Else
Selection.Resize(UBound(D), UBound(D, 2)) = D
End If
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
fichier = Dir
If entetes Then entetes = False: debut = debut + 1 ' on passe l'en-tête pour les fichiers suivants
Loop
End Sub
Function Utf8_Decode(ByVal txt As String) As String
Dim ln As Long, s As String, i As Integer, j As Integer, K As Integer
For ln = 1 To Len(txt)
i = Asc(Mid(txt, ln, 1))
If i > 127 Then
If Not i And 32 Then
j = Asc(Mid(txt, ln + 1, 1))
s = s & ChrW$(((31 And i) * 64 + (63 And j)))
ln = ln + 1
Else
j = Asc(Mid(txt, ln + 1, 1))
K = Asc(Mid(txt, ln + 2, 1))
s = s & ChrW$(((i And 15) * 16 * 256) + ((j And 63) * 64) + (K And 63))
ln = ln + 2
End If
Else
s = s & Chr$(i)
End If
Next ln
Utf8_Decode = s
End Function
@Tony .... je viens de tester ma macro, c'est ok, mais il s'agit de compiler à la queue leu leu les fichiers.
Tu peux t'inspirer de la macro et de la fonction de décodage pour modifier ta macro qui enregistre chaque csv indépendamment !
Ou bien poursuis avec PowerQ (bonjour Chris)
Merci @Steelson je vais tester de suite ^^
Et merci @78Chris, je suis curieux de voir des exemples d'utilisation
Je vous tiens au courant
Peux-tu joindre 2 fichiers exemples, de structure différentes pour modéliser
@Chris ... je me suis fait 2 fichiers blindés de caractères diacritiques latin. La structure est différente.
Une solution VBA
Option Explicit
Const sep = ";"
Sub csv2xlsx()
Dim chemin$, Rep As FileDialog
' choix du répertoire
Set Rep = Application.FileDialog(msoFileDialogFolderPicker)
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire des fichiers ..."
Rep.Show
If Rep.SelectedItems.Count = 0 Then Exit Sub
chemin = Rep.SelectedItems(1) & "\"
importCSV chemin
End Sub
Sub importCSV(chemin As String)
' sep est le séparateur , ou ; ou vbTab
' debut caractérise la première ligne du fichier csv à importer
' entetes indique s'il faut importer les en-têtes se trouvant sur la ligne début
Dim wb As Workbook, ws As Worksheet
Dim fichier$, T() As String, D, ligne&, i%, ContenuLigne$, nItems%, ff
fichier = Dir(chemin & "*.csv")
Do While fichier <> ""
ff = FreeFile
Open chemin & fichier For Input As #ff
ligne = 0
Do While Not EOF(1)
ligne = ligne + 1
Line Input #ff, ContenuLigne
T = Split(ContenuLigne, sep)
nItems = UBound(T) + 1
If ligne = 1 Then ReDim D(1 To nItems, 1 To 1)
If ligne > 1 Then ReDim Preserve D(1 To nItems, 1 To ligne) ' Preserve ne permet de redimensionner que la dernière dimension d'un tableau avec conservation des données
For i = 0 To UBound(T)
D(i + 1, ligne) = Utf8_Decode(T(i))
Next i
Loop
Close #ff
D = Application.Transpose(D)
Set wb = Workbooks.Add ' On ajoute un classeur
Set ws = wb.Worksheets(1) ' On crée l'objet onglet dans le nouveau classeur créé
If ligne = 1 Then
ws.Cells(1, 1).Resize(1, UBound(D)) = D ' cas d'une seule ligne dans le fichier csv
Else
ws.Cells(1, 1).Resize(UBound(D), UBound(D, 2)) = D
End If
wb.SaveAs chemin & Replace(fichier, ".csv", ".xlsx")
wb.Close
fichier = Dir
Loop
End Sub
Function Utf8_Decode(ByVal txt As String) As String
Dim ln As Long, s As String, i As Integer, j As Integer, K As Integer
For ln = 1 To Len(txt)
i = Asc(Mid(txt, ln, 1))
If i > 127 Then
If Not i And 32 Then
j = Asc(Mid(txt, ln + 1, 1))
s = s & ChrW$(((31 And i) * 64 + (63 And j)))
ln = ln + 1
Else
j = Asc(Mid(txt, ln + 1, 1))
K = Asc(Mid(txt, ln + 2, 1))
s = s & ChrW$(((i And 15) * 16 * 256) + ((j And 63) * 64) + (K And 63))
ln = ln + 2
End If
Else
s = s & Chr$(i)
End If
Next ln
Utf8_Decode = s
End Function
RE
J'ai modélisé sur les 2 fichiers de Steelson mais ne sachant pas quels sont les paramètres régionaux des véritables fichiers, j'attends les vrais exemples car cela n'est pas neutre pour les dates et les nombres
Il peut y avoir aussi (dans les fichiers attendus) des informations de tête qui ne recoupent pas toutes les colonnes. Dans mon cas, le "tableau" est carré avec le même nombre d'informations sur toutes les lignes. Cela ne conviendra pas si ce n'est pas le cas !
Bonjour,
Désolé pour l'attente je n'ai pas encore réussi mais je continue à essayer.
Voici les 2 fichiers que j'aimerai traduire. Il y en a un pour lequel il n'y a pas de caractères spéciaux (libelle) donc ça passe par contre pour l'autre ça ne passe pas.
Je n'arrive pas importer les fichiers avec le fichier reçu.
Le but est de les importer les traduire en UTF8 et les enregistrer en XLSX au même endroit.
Par rapport à mon code, les manipulation semblent différentes mais j'ai du mal à intégrer seulement la procédure ou la fonction qui va bien.
Est-ce que vous pouvez m'aider svp?
Bonjour
Une ligne par fichier, c'est assez léger pour tester...
Cela fonctionne avec PowerQuery + VBA mais, comme on ne connait ni les noms ni le type des colonnes, cela met tout comme texte
On pourrait éventuellement chercher les nombres sur la 1ère ligne mais si elle n'est pas représentative...
Voici les 2 fichiers que j'aimerai traduire. Il y en a un pour lequel il n'y a pas de caractères spéciaux (libelle) donc ça passe par contre pour l'autre ça ne passe pas.
Je n'arrive pas importer les fichiers avec le fichier reçu.
Ah bon, j vais essayer de mon côté avec la solution proposée.
J'ai traduis correctement les 2 en terme de caractères, il reste un petit réglage à faire car tout se trouve sur la même ligne (curieux pour un fichier csv)
Bonjour,
Merci pour votre aide par contre je suis navré j'ai essayé le code de @Steelson et j'ai une incompatibilité de type sur la ligne ci-dessous:
D = Application.Transpose(D)
Est-ce qu'il faut mettre un autre type que "String" svp.
J'ai essayé de trouver une parade mais avec PowerQuery et VBA mais vu que les colonnes peuvent être variable au niveau du nombre et que je suis pas très à l'aise, j'ai pas l'impression que je peux m'en sortir.
C'est que probablement tu ne dois avoir qu'une seule ligne...
et du reste, cela me semble être dû au fichier pour lequel je n'arrive pas à détecter la fin de ligne.
Essaie cette solution qui traite ligne par ligne et non plus globalement le fichier.
Option Explicit
Const sep = ";"
Sub csv2xlsx()
Dim chemin$, Rep As FileDialog
' choix du répertoire
Set Rep = Application.FileDialog(msoFileDialogFolderPicker)
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire des fichiers ..."
Rep.Show
If Rep.SelectedItems.Count = 0 Then Exit Sub
chemin = Rep.SelectedItems(1) & "\"
importCSV chemin
End Sub
Sub importCSV(chemin As String)
Dim wb As Workbook, ws As Worksheet
Dim fichier$, T() As String, D, ligne&, i%, ContenuLigne$, nItems%, ff
fichier = Dir(chemin & "*.csv")
Do While fichier <> ""
Set wb = Workbooks.Add
Set ws = wb.Worksheets(1)
ff = FreeFile
Open chemin & fichier For Input As #ff
ligne = 0
Do While Not EOF(1)
ligne = ligne + 1
Line Input #ff, ContenuLigne
T = Split(Utf8_Decode(ContenuLigne) & sep, sep)
ws.Cells(ligne, 1).Resize(1, UBound(T)) = T
Loop
Close #ff
wb.SaveAs chemin & Replace(fichier, ".csv", ".xlsx")
wb.Close
fichier = Dir
Loop
End Sub
Function Utf8_Decode(ByVal txt As String) As String
Dim ln As Long, s As String, i As Integer, j As Integer, K As Integer
For ln = 1 To Len(txt)
i = Asc(Mid(txt, ln, 1))
If i > 127 Then
If Not i And 32 Then
j = Asc(Mid(txt, ln + 1, 1))
s = s & ChrW$(((31 And i) * 64 + (63 And j)))
ln = ln + 1
Else
j = Asc(Mid(txt, ln + 1, 1))
K = Asc(Mid(txt, ln + 2, 1))
s = s & ChrW$(((i And 15) * 16 * 256) + ((j And 63) * 64) + (K And 63))
ln = ln + 2
End If
Else
s = s & Chr$(i)
End If
Next ln
Utf8_Decode = s
End Function