Function Chr2Unicode(byval str)
    Dim st, t, i,t1
    For i = 1 To Len(str)
        t = Hex(AscW(Mid(str, i, 1)))
        If (Len(t) < 4) Then
            while (Len(t) < 4)
            t = "0"&t 
            Wend
        End If
        t = Mid(t, 3) & Left(t, 2)
        t1=mid(t,3,2)&mid(t,1,2)
        st = st & t1
    Next
    Chr2Unicode = LCase(st)
End Function