Private Const CP_UTF8 = 65001
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 String, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Public Function UTF8_Encode(ByRef vsInput As String) As String
Dim nLength As Long
nLength = Len(vsInput)
If nLength Then
nLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(vsInput), nLength, 0, 0, 0, 0)
UTF8_Encode = Space$(nLength)
nLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(vsInput), -1, UTF8_Encode, nLength, 0, 0)
End If
End Function
Function UrlEncode(ByRef vsInput As String) As String
Dim i As Long
Dim xsAnsi() As Byte
Dim nChar As Byte
xsAnsi = StrConv(UTF8_Encode(vsInput), vbFromUnicode)
For i = 0 To UBound(xsAnsi)
nChar = xsAnsi(i)
Select Case nChar
Case 48 To 57, 65 To 90, 97 To 122
UrlEncode = UrlEncode & Chr$(nChar)
Case Else
If nChar < 16 Then
UrlEncode = UrlEncode & "%0" & Hex$(nChar)
Else
UrlEncode = UrlEncode & "%" & Hex$(nChar)
End If
End Select
Next i
End Function