Macro qui convertit un fichier Excel en CSV UTF-8

Bonjour, j'ai plusieurs macros VBA, je veux principalement convertir un fichier Excel en un fichier CSV encodé UTF-8 sans nomenclature

Sub Main()

    Dim fileToConvertInCSV As String
    Dim fileToConvertInUTF8 As String

    fileToConvertInCSV = FileSelected
    fileToConvertInUTF8 = CSVConverted(fileToConvertInCSV)
    Call WriteANSItoUF8WithoutBOM(fileToConvertInUTF8, fileToConvertInUTF8)

    'améliorations à implémenter
    'File Selected => n'autoriser que la sélection Excel
    'ConvertUTF8 => convertir en UTF8 sans N

End Sub

Function FileSelected() As String
    'Function to Open a file

    Dim fd As Office.FileDialog

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
       .Filters.Clear
       '.Filters.Add "Excel Files", "*.xlsx?", 1
       .Title = "Choose an Excel file"
       .AllowMultiSelect = False

       If .Show = True Then
           FileSelected = .SelectedItems(1)
       End If
    End With

End Function

Function CSVConverted(fileToConvert As String) As String

    Dim toConvertFile As String
    Dim convertedFile As String
    Dim Rows As Long
    Dim Cols As Long
    Dim J As Long
    Dim K As Long
    Dim sTemp As String
    Dim sSep As String
    Dim wb As Workbook

    Const adCrLf                As Long = -1
    Const adModeUnknown         As Long = 0
    Const adSaveCreateOverWrite As Long = 2
    Const adTypeText            As Long = 2

    sSep = ";!@#;" 'Specify the separator to be used

    toConvertFile = fileToConvert

    Workbooks.Open toConvertFile
    Sheets(1).Activate

    Dim fileExtension As String
    fileExtension = Right(toConvertFile, Len(toConvertFile) - InStrRev(toConvertFile, "."))

    If fileExtension = "xlsm" Or fileExtension = "xlsx" Or fileExtension = ".xlsb" Or fileExtension = ".xls" Then

        toConvertFile = Mid(toConvertFile, 1, Len(toConvertFile) - Len(fileExtension))
        convertedFile = toConvertFile & ".csv"
        Open convertedFile For Output As 1

        With ActiveSheet
            'Number of rows to export is based on the contents
            'of column J. If it should be based on a different
            'column, change the following line to reflect the
            'column desired.
            Rows = .Cells(.Rows.Count, "J").End(xlUp).Row
            For J = 1 To Rows
                sTemp = ""
                Cols = .Cells(J, .Columns.Count).End(xlToLeft).Column
                For K = 1 To Cols
                    sTemp = sTemp & .Cells(J, K).Value
                    If K < Cols Then sTemp = sTemp & sSep
                Next
                Print #1, sTemp
            Next J
        End With

        Close 1

        sTemp = "There were " & Rows & " rows of data written "
        sTemp = sTemp & "to this file:" & vbCrLf & toConvertFile
    Else
        sTemp = "This macro needs to be run on a workbook "
        sTemp = sTemp & "stored in the XLSX, XLSM, XLSB or XLS format."
    End If

    ActiveWorkbook.Close

    'Dim wbName As String
    'wbName = Right(toConvertFile, Len(toConvertFile) - InStrRev(toConvertFile, "\"))

    'For Each wb In Workbooks
    '    If wb.Name = wbName Then
    '        Workbooks.Close wbName
    '        Exit Sub
    '    End If
    'Next

    MsgBox sTemp

    CSVConverted = convertedFile

End Function

Ces macros permettent de convertir en fichier CSV, mais ensuite il faut encoder en UTF-8, il y a deux macros

Sub ConvertUTF8(fileToConvert, fileToSave As String)

    Dim fileToConvertPath, fileToSavePath As String

    fileToConvertPath = fileToConvert
    fileToSavePath = fileToSave

    Set UTFStream = CreateObject("ADODB.Stream"): 'Create Stream object
        UTFStream.Type = 2: 'Specify stream type – we want To save text/string data.
        UTFStream.Charset = "utf-8": 'Specify charset For the source text data.
        UTFStream.Open: 'Open the stream
        UTFStream.LoadFromFile fileToConvertPath: 'And write the file to the object stream
        UTFStream.SaveToFile fileToSavePath, 2: 'Save the data to the named path

        'skip BOM
      UTFStream.Position = 3

        'copy UTFStream to BinaryStream
      Set BinaryStream = CreateObject("adodb.stream")
      BinaryStream.Type = adTypeBinary
      BinaryStream.Mode = adModeReadWrite
      BinaryStream.Open

      'Strips BOM (first 3 bytes)
      UTFStream.CopyTo BinaryStream

      UTFStream.Flush
      UTFStream.Close

      'save to file
      BinaryStream.SaveToFile FName, adSaveCreateOverWrite
      BinaryStream.Flush
      BinaryStream.Close

Cette macro là retourne UTF_8 avec nomenclature (mais je ne veux pas ça)

Sub WriteANSItoUF8WithoutBOM(fileToConvert, fileToSave As String)

    Dim fileToConvertPath, fileToSavePath As String

    fileToConvertPath = fileToConvert
    fileToSavePath = fileToSave

    Set UTFStream = CreateObject("adodb.stream")
    Set ANSIStream = CreateObject("adodb.stream")
    Set BinaryStream = CreateObject("adodb.stream")

    ANSIStream.Type = adTypeText
    ANSIStream.Mode = adModeReadWrite
    ANSIStream.Charset = "iso-8859-1"
    ANSIStream.Open
    ANSIStream.LoadFromFile fileToConvertPath  'ANSI File

    UTFStream.Type = adTypeText
    UTFStream.Mode = adModeReadWrite
    UTFStream.Charset = "UTF-8"
    UTFStream.Open
    ANSIStream.CopyTo UTFStream

    UTFStream.Position = 3 'skip BOM
    BinaryStream.Type = adTypeBinary
    BinaryStream.Mode = adModeReadWrite
    BinaryStream.Open

    'Strips BOM (first 3 bytes)
    UTFStream.CopyTo BinaryStream

    BinaryStream.SaveToFile fileToSavePath, adSaveCreateOverWrite
    BinaryStream.Flush
    BinaryStream.Close
End Sub

Et celle là me retourne un fichier ANSI

je ne vois pas comment faire UTF 8 simple, merci d'avance de votre aide

En tout cas c'est sur les 2 derniers codes de conversion UTF 8 que ça bug

Le premier me retourne un UTF 8 avec nomenclature mais les accents ne sont pas pris en compte et remplacés par des caractères moches

Le deuxieme me retourne un ANSI alors que pourtant j'ai demandé UTF 8

Je suis vraiment perdu, de prime abord je dirais que le deuxième est meilleur mais quel est le probleme, pourquoi ça ne marche pas ?

Bonjour

L'enregistrement de CSV en UTF8 existe, depuis la version 2010 il me semble.

Donc je ne comprends pas à quoi sert tout ce code

Le but c'est surtout d'automatiser le plus possible ce genre d'action avec par exemple un bouton

RE

Oui une ligne suffit...

ActiveWorkbook.SaveAs Filename:= _
        "Chemin\Nom.csv", _
        FileFormat:=xlCSVUTF8, CreateBackup:=False

J'ai trouvé ! Il fallait juste activer Microsoft ActiveX Data Objects dans les références :)