How can I convert UTF-8 to UTF-16 in Excel VBA?

user_11344936 0
Viewed 1401

As far as I know, Excel use UTF-16 to represent string literals. I read from a console (Mac) / file (Windows), and in both cases the character encoding is messed up. I have to find a solution which works on both platforms, so ADO stream is not an option. I made some debugging and I see that actual bytes are:

Bytes     | Displayed as | Should be | Correct byte
258,129   | Ă           | Á         | 193
258,356   | ĂŤ           | Í         | 205
313,176   | Ĺ°           | Ű         | 219
313,144   | Ĺ           | Ő         | 213
258,347   | Ăś           | Ü         | 220
258,8211  | Ă–           | Ö         | 214
258,353   | Ăš           | Ú         | 218
258,8220  | Ă“           | Ó         | 211
258,8240  | É           | É         | 201

(Comes from the good-old hungarian test-phrase, ÁRVÍZTŰRŐ TÜKÖRFÚRÓGÉP which contains all of our special characters). I am looking for an algorithm which results in the correct string both on Mac and Windows. Thanks!

utf-16 utf-8 vba excel
3 Answers

As I had to solve this, I came up with the following function which can successfully transform the characters which are between 128 and 255

Private Function utf8ToUTF16(ByVal strText As String) As String
    Dim i&, l1%, l2%, l3%
    For i = 1 To Len(strText)
        l1 = Asc(Mid(strText, i, 1))
        If i <> Len(strText) Then l2 = Asc(Mid(strText, i + 1, 1))
        Select Case l1
        Case 194
            utf8ToUTF16 = utf8ToUTF16 & WorksheetFunction.Unichar(l2): i = i + 1
        Case 195
            utf8ToUTF16 = utf8ToUTF16 & WorksheetFunction.Unichar(l2 + &H40): i = i + 1
        Case 197
            utf8ToUTF16 = utf8ToUTF16 & WorksheetFunction.Unichar(l2 + &HC0): i = i + 1
        Case 203
            utf8ToUTF16 = utf8ToUTF16 & WorksheetFunction.Unichar(l2 + &H240): i = i + 1
        Case 226
            If l2 = 128 Then
                l3 = Asc(Mid(strText, i + 2, 1))
                utf8ToUTF16 = utf8ToUTF16 & WorksheetFunction.Unichar(l3 + &H1F80)
                i = i + 2
            ElseIf l2 = 130 Then
                l3 = Asc(Mid(strText, i + 2, 1))
                utf8ToUTF16 = utf8ToUTF16 & WorksheetFunction.Unichar(l3 + &H2000)
                i = i + 2
            End If
        Case Else
            utf8ToUTF16 = utf8ToUTF16 & Chr(l1)
        End Select
    Next i
End Function

Now passing "ĂRVĂŤZTĹ°RĹ TĂśKĂ–RFĂšRĂ“GÉP" to this function (which is read from a standard UTF-8 encoded file) will return "ÁRVÍZTŰRŐ TÜKÖRFÚRÓGÉP".

  • Note: this is not be the most efficient code, for sure. Whenever I call it I always use it on the shortest string possible. Currently I use it to decode a result from cURL, and passing the whole HTML froze it.

EDIT

Now I had some time to clean up this.

Private Function utf8ToUTF16(ByVal strText As String) As String
    Dim i&, l1&, l2&, l3&, l4&, l&
    For i = 1 To Len(strText)
        l1 = Asc(Mid(strText, i, 1))
        If i + 1 <= Len(strText) Then l2 = Asc(Mid(strText, i + 1, 1))
        If i + 2 <= Len(strText) Then l3 = Asc(Mid(strText, i + 2, 1))
        If i + 3 <= Len(strText) Then l4 = Asc(Mid(strText, i + 3, 1))
        Select Case l1
        Case 1 To 127
            l = l1
        Case 194 To 223
            l = ((l1 And &H1F) * 2 ^ 6) Or (l2 And &H3F)
            i = i + 1
        Case 224 To 239
            l = ((l1 And &HF) * 2 ^ 12) Or ((l2 And &H3F) * 2 ^ 6) Or (l3 And &H3F)
            i = i + 2
        Case 240 To 255
            l = ((l1 And &H7) * 2 ^ 18) Or ((l2 And &H3F) * 2 ^ 12) Or ((l3 And &H3F) * 2 ^ 6) Or (l4 And &H3F)
            i = i + 4
        Case Else
            l = 63 ' question mark
        End Select
        utf8ToUTF16 = utf8ToUTF16 & IIf(l < 55296, WorksheetFunction.Unichar(l), "?")
    Next i
End Function

As I realized, characters above 55295 (D7FF) will not appear, so it will output a question mark instead as a placeholder.

user_113449360

I found this simple VBA code worked well for Spanish accented characters in a text file. Given a string with the UTF-8 double-characters it returns a string with accented characters:

Function UTF8to16(str As String) As String
Dim position As Long, strConvert As String, codeReplace As Integer, strOut As String

strOut = str
position = InStr(strOut, Chr(195))

If position > 0 Then
    Do Until position = 0
        strConvert = Mid(strOut, position, 2)
        codeReplace = Asc(Right(strConvert, 1))
        If codeReplace < 255 Then
            strOut = Replace(strOut, strConvert, Chr(codeReplace + 64))
        Else
            strOut = Replace(strOut, strConvert, Chr(34))
        End If
        position = InStr(strOut, Chr(195))
    Loop
End If

UTF8to16 = strOut

End Function
user_162251100

This works for me

Function utf8ToUTF16(ByVal strText As String) As String
    Dim binText() As Byte, i As Long
    'size the binary buffer
    ReDim binText(Len(strText) - 1 + 3)
    'insert BOM in 0,1,2 positions
    binText(0) = &HEF
    binText(1) = &HBB
    binText(2) = &HBF
    'append text characters
    For i = 1 To Len(strText)
        binText(i + 2) = Asc(Mid(strText, i, 1))
    Next
    'write to a binary stream
    With CreateObject("ADODB.Stream")
        .Type = 1
        .Open
        .write binText
        'convert to the text stream
        .Flush
        .Position = 0
        .Type = 2
        .Charset = "utf-8"
     'read the result skipping BOM
        .Position = 3
        utf8ToUTF16 = .ReadText
        .Close
    End With
End Function
user_131005040
Related