XL 2016 Convertir plusieurs CSV UTF 8 en XLSX

Tony74

XLDnaute Nouveau
Bonjour,
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:

VB:
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
 

Discussions similaires

Haut Bas