Option Explicit

' ***********************************************************************
' *****                                                             *****
' *****        CODE PierreP56 : http://tatiak.canalblog.com/        *****
' *****                                                             *****
' ***********************************************************************

Public Const adModeReadWrite = 3
Public Const adTypeBinary = 1
Public Const adTypeText = 2

Sub test()
Dim S As String

    S = "èéçàù"
    Debug.Print Utf8_Encode(S)
    S = Utf8_Encode(S)
    Debug.Print Utf8_Decode(S)
End Sub


'  Inspiré de BodwadUK : http://www.vbforums.com/showthread.php?674670-utf-8-string-converter
Public Function Utf8_Encode(ByRef Txt As String) As String
Dim Data() As Byte, S As String, i As Long
       
    With CreateObject("ADODB.Stream")   ' init stream
        .Charset = "utf-8"
        .Mode = adModeReadWrite
        .Type = adTypeText
        .Open
        .WriteText Txt                  ' write bytes into stream
        .Flush
        .Position = 0                   ' rewind stream and read text
        .Type = adTypeBinary
        .Read 3                         ' skip first 3 bytes as this is the utf-8 marker
        Data = .Read()
        .Close                          ' close up and return
    End With
        
    For i = 0 To UBound(Data)           'Convert back to ascii
        S = S & Chr(Data(i))
    Next i
    Utf8_Encode = S
End Function


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