Convert unicode characters to Arabic letters

[YasserKhalil]

Hello everyone

I have the following code that extracts part of JSON file

Code: Select all

Sub Test()
    Dim s As String, json As Object
    
    s = CreateObject("Scripting.FileSystemObject").OpenTextFile(ThisWorkbook.Path & "\Sample.json").ReadAll
    
    Set json = JSONConverter.ParseJson(s)("result")
    ActiveCell.Value = json("sID")
End Sub

The code works fine for the English letters ..but as for Arabic letters, the code doesn't display the letters correctly on the cell
This is the JSON content

Code: Select all

{"result":{"found":true,"id":"12","sID":"\u00d8\u00a7\u00d9\u0084\u00d8\u00ad\u00d9\u0085\u00d8\u00af \u00d9\u0084\u00d9\u0084\u00d9\u0087","hexValue":"d8a7d984d8add985d8af20d984d984d987","hits":1,"sysmsg":[],"credit":{"name":"hed","link":"https:\/\/www.example.net\/db\/"}}}

How can I convert the characters in the cell (which is the output) to appear properly in the worksheet?

[HansV]

What is JSONConverter?

[YasserKhalil]

It is a library (BASE module) that is used to parse JSON
https://github.com/VBA-tools/VBA-JSON/b ... verter.bas" onclick="window.open(this.href);return false;

[HansV]

I guess you'll need someone with an Arabic system to help you.

[YasserKhalil]

Thanks a lot.
Can hex value be converted to a string?

[HansV]

Yes, but on my system it will not display Arabic...

[YasserKhalil]

Can you please give me the code that converts the hex to string to test on my side?

[HansV]

The result is the same as that of the JSON converter:

Code: Select all

Sub Convert()
    Dim strHex As String
    Dim strText As String
    Dim i As Long
    strHex = "d8a7d984d8add985d8af20d984d984d987"
    For i = 1 To Len(strHex) Step 2
        strText = strText & Chr("&H" & Mid(strHex, i, 2))
    Next i
    MsgBox strText
End Sub

[YasserKhalil]

Thanks a lot Mr. Hans
I found a UDF that would help us in this topic

Code: Select all

Function String2Html(strText As String) As String

Dim i As Integer
Dim strOut As String
Dim char As String
Dim char2 As String
Dim intCharCode As Integer
Dim intChar2Code As Integer
Dim unicode_cp As Long


For i = 1 To Len(strText)
    char = Mid(strText, i, 1)
    intCharCode = AscW(char)
    If (intCharCode And &HD800) = &HD800 Then
        i = i + 1
        char2 = Mid(strText, i, 1)
        intChar2Code = AscW(char2)
        unicode_cp = (intCharCode And &H3FF) * (2 ^ 10) + (intChar2Code And &H3FF)
        strOut = strOut & "&#x" & CStr((intCharCode And &H3C0) + 1) & Hex(unicode_cp) & ";"
    ElseIf intCharCode > 127 Then
        strOut = strOut & "&#x" & Hex(intCharCode) & ";"
    ElseIf intCharCode < 0 Then
        strOut = strOut & "&#x" & Hex(65536 + intCharCode) & ";"
    Else
        strOut = strOut & char
    End If
Next
String2Html = strOut 'Replace(strOut, ";&#x", "%")

End Function

When I tried this (for fun) on the text in the cell (the Arabic letters that is disrupted), I got the following

Untitled.png

Can you help me to fix that? to be exactly as the output of the encodedurl .. ? I think this can be QuotedPrintableDecode which you have helped me before to convert from

[HansV]

It looks like you need to replace:
"&#x" with "%"
";" with ""
" " with "%20"

[YasserKhalil]

Thank you very much. That worked very well
Thanks a lot for the great support in this topic and each topic.