Option Explicit
Function ToUnicode(txtString As String, Optional isReversed As Boolean = False, Optional isISO As Boolean = False) As String
' This function will do the conversion of text string into unicode
Dim iStr As String, repTxt As String, mText As String
Dim i As Long, j As Long
Dim iUnicode As Variant ' array to keep unicode char set
Dim iTCVN As Variant ' array to keep TCVN char set
Dim iProcList() As String ' array to keep what to convert
'parse the parameter into this local variable
iStr = txtString
mText = txtString
iUnicode = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, _
7845, 7847, 7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 234, 7871, 7873, 7875, _
7877, 7879, 237, 236, 7881, 297, 7883, 243, 242, 7887, 245, 7885, 244, 7889, 7891, _
7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 250, 249, 7911, 361, 7909, _
432, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, 7925, 273, 193, 192, 195, _
258, 194, 212, 416, 431, 272)
iTCVN = Array(184, 181, 182, 183, 185, 168, 190, 187, 188, 189, 198, 169, 202, 199, 200, _
201, 203, 208, 204, 206, 207, 209, 170, 213, 210, 211, 212, 214, 221, 215, 216, 220, _
222, 227, 223, 225, 226, 228, 171, 232, 229, 230, 231, 233, 172, 237, 234, 235, 236, _
238, 243, 239, 241, 242, 244, 173, 248, 245, 246, 247, 249, 253, 250, 251, 252, 254, _
174, 193, 192, 195, 161, 162, 164, 165, 166, 167)
' Reenlarge the array
ReDim iProcList(1, 133)
' process the vowel only and covert to asc code
For i = 1 To Len(mText)
repTxt = Mid(mText, i, 1)
If AscW(repTxt) > 122 Then
iStr = Replace(iStr, repTxt, "[" & AscW(repTxt) & "]")
mText = Replace(mText, repTxt, " ")
' write the processed list
iProcList(1, j) = "[" & AscW(repTxt) & "]"
If isISO Then
iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
Else
If isReversed Then
iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
Else
iProcList(0, j) = GetElementNo(AscW(repTxt), iTCVN)
End If
End If
j = j + 1
End If
Next
If j = 0 Then
ToUnicode = txtString
Exit Function
End If
ReDim Preserve iProcList(1, j - 1)
' now convert to unicode
For i = 0 To UBound(iProcList, 2)
If isReversed Then
iStr = Replace(iStr, iProcList(1, i), ChrW(iTCVN(Val(iProcList(0, i)))))
Else
If isISO Then
iStr = Replace(iStr, iProcList(1, i), "&#" & iUnicode(Val(iProcList(0, i))) & ";")
Else
iStr = Replace(iStr, iProcList(1, i), ChrW(iUnicode(Val(iProcList(0, i)))))
End If
End If
Next
fExit:
ToUnicode = iStr
End Function
Private Function GetElementNo(iTxt As Long, iObj As Variant) As String
Dim i As Long
For i = 0 To UBound(iObj)
If iTxt = iObj(i) Then
GetElementNo = CStr(i)
Exit For
End If
Next
End Function
