Convert Hex to Unicode

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Convert Hex to Unicode

Post by YasserKhalil »

Hello everyone\In previous thread, I have made use of a UDF that converts the Arabic letters (that appeared in weird way) to more readable letters
This is the code I used

Code: Select all

Sub Test()
    Dim x, s As String, output As String, i As Long
    s = "\u00d8\u00b3\u00d9\u0087\u00d8\u00a7\u00d9\u0085 \u00d9\u0085\u00d8\u00ad\u00d9\u0085\u00d8\u00af"
    x = Split(s, "\")
    For i = LBound(x) + 1 To UBound(x)
        output = output & IIf(Right(x(i), 1) = " ", Hex2Uni(x(i)) & " ", Hex2Uni(x(i)))
    Next i
    Debug.Print output
End Sub

Function Hex2Uni(ByVal Txt As String) As String
    Txt = Replace(Txt, "u", "&h")
    Hex2Uni = ChrW(Txt)
End Function
But as for the string in the code , I couldn't get the right readable characters for Arabic. Any ideas?

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Convert Hex to Unicode

Post by YasserKhalil »

I have used the following functions and attached sample workbook. The Arabic letters are OK now but as the English names are empty in results and some of them procduces VALUE error

Code: Select all

Function String2HTML(strText As String) As String
    Dim sOut As String, s1 As String, s2 As String, i As Integer, m1 As Integer, m2 As Integer, k As Long
    For i = 1 To Len(strText)
        s1 = Mid(strText, i, 1)
        m1 = AscW(s1)
        If (m1 And &HD800) = &HD800 Then
            i = i + 1
            s2 = Mid(strText, i, 1)
            m2 = AscW(s2)
            k = (m1 And &H3FF) * (2 ^ 10) + (m2 And &H3FF)
            sOut = sOut & "&#x" & CStr((m1 And &H3C0) + 1) & Hex(k) & ";"
        ElseIf m1 > 127 Then
            sOut = sOut & "&#x" & Hex(m1) & ";"
        ElseIf m1 < 0 Then
            sOut = sOut & "&#x" & Hex(65536 + m1) & ";"
        Else
            sOut = sOut & s1
        End If
    Next i
    sOut = Replace(Replace(Replace(sOut, "&#x", "%"), ";", ""), " ", "%20")
    String2HTML = Replace(sOut, "%", "=")
End Function

Function QuotedPrintableDecode(s As String) As String
    Dim r As String, i As Long, p1 As Long, p2 As Long
    i = 2
    Do While i < Len(s)
        Select Case Mid(s, i, 1)
            Case "0" To "7"
                r = r & Chr(CLng("&H" & Mid(s, i, 2)))
            Case "C", "D"
                p1 = CLng("&H" & Mid(s, i, 2)) - 192
                i = i + 3
                p2 = CLng("&H" & Mid(s, i, 2)) - 128
                r = r & ChrW(64 * p1 + p2)
            Case Else
        End Select
        i = i + 3
    Loop
    QuotedPrintableDecode = r
End Function
You do not have the required permissions to view the files attached to this post.