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.