Option Explicit
#If VBA7 Then
'Maps a UTF-16 (wide character) string to a byte array
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" _
(ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long, ByVal lpMultiByteStr As LongPtr, ByVal cbMultiByte As Long, ByVal lpDefaultChar As LongPtr, ByVal lpUsedDefaultChar As LongPtr) As Long
#Else
Private Declare Function WideCharToMultiByte Lib "kernel32" _
(ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cbMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
#End If
'UTF-8 code page
Private Const CP_UTF8 = 65001
Public Function UTF8toHex(UTF8string As String) As String
Dim bytes() As Byte, i As Long
UTF8toHex = ""
bytes = Utf8StringToBytes(UTF8string)
For i = 0 To UBound(bytes)
UTF8toHex = UTF8toHex & Right("0" & Hex(bytes(i)), 2)
Next
End Function
'Return byte array of VBA Unicode string encoded in UTF-8
Private Function UTF8StringToBytes(strInput As String) As Byte()
Dim nBytes As Long
Dim bytes() As Byte
'Catch null input string
If strInput = vbNullString Then
UTF8StringToBytes = vbNullString
Else
'Get length in bytes
nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), Len(strInput), 0&, 0&, 0&, 0&)
'Allocate zero-based array to receive the bytes
ReDim bytes(0 To nBytes - 1)
'Map string to byte array
nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), Len(strInput), ByVal VarPtr(bytes(0)), nBytes, 0&, 0&)
UTF8StringToBytes = bytes
End If
End Function
