Ни одно из предложенных здесь решений не работало для меня из коробки, но, скорее всего, это было связано с моим отсутствием опыта работы с VBA. Это также может быть связано с тем, что я просто скопировал и вставил некоторые из перечисленных выше функций, не зная деталей, которые, возможно, необходимы для их работы в среде VBA для приложений.
Мне нужно было просто отправлять запросы xmlhttp, используя URL-адреса, которые содержали некоторые специальные символы норвежского языка. Некоторые из приведенных выше решений кодируют даже двоеточия, что делает URL-адреса неподходящими для того, что мне нужно.
Затем я решил написать свою собственную функцию URLEncode. Он не использует более умное программирование, такое как @ndd и @Tom. Я не очень опытный программист, но я должен был сделать это раньше.
Я понял, что проблема в том, что мой сервер не принимает кодировки UTF-16, поэтому мне пришлось написать функцию, которая конвертирует UTF-16 в UTF-8. Хороший источник информации был найден здесь и здесь .
Я не тестировал его всесторонне, чтобы проверить, работает ли он с URL-адресами с символами, которые имеют более высокие значения Юникода и которые выдают более 2 байтов символов utf-8. Я не говорю, что он будет декодировать все, что нужно декодировать (но его легко изменить, чтобы включить / исключить символы в операторе select case), а также что он будет работать с более высокими символами, поскольку я не полностью протестировал. Но я делюсь кодом, потому что он может помочь кому-то, кто пытается понять проблему.
Любые комментарии приветствуются.
Public Function URL_Encode(ByVal st As String) As String
Dim eachbyte() As Byte
Dim i, j As Integer
Dim encodeurl As String
encodeurl = ""
eachbyte() = StrConv(st, vbFromUnicode)
For i = 0 To UBound(eachbyte)
Select Case eachbyte(i)
Case 0
Case 32
encodeurl = encodeurl & "%20"
' I am not encoding the lower parts, not necessary for me
Case 1 To 127
encodeurl = encodeurl & Chr(eachbyte(i))
Case Else
Dim myarr() As Byte
myarr = utf16toutf8(eachbyte(i))
For j = LBound(myarr) To UBound(myarr) - 1
encodeurl = encodeurl & "%" & Hex(myarr(j))
Next j
End Select
Next i
URL_Encode = encodeurl
End Function
Public Function utf16toutf8(ByVal thechars As Variant) As Variant
Dim numbytes As Integer
Dim byte1 As Byte
Dim byte2 As Byte
Dim byte3 As Byte
Dim byte4 As Byte
Dim byte5 As Byte
Dim i As Integer
Dim temp As Variant
Dim stri As String
byte1 = 0
byte2 = byte3 = byte4 = byte5 = 128
' Test to see how many bytes the utf-8 char will need
Select Case thechars
Case 0 To 127
numbytes = 1
Case 128 To 2047
numbytes = 2
Case 2048 To 65535
numbytes = 3
Case 65536 To 2097152
numbytes = 4
Case Else
numbytes = 5
End Select
Dim returnbytes() As Byte
ReDim returnbytes(numbytes)
If numbytes = 1 Then
returnbytes(0) = thechars
GoTo finish
End If
' prepare the first byte
byte1 = 192
If numbytes > 2 Then
For i = 3 To numbytes
byte1 = byte1 / 2
byte1 = byte1 + 128
Next i
End If
temp = 0
stri = ""
If numbytes = 5 Then
temp = thechars And 63
byte5 = temp + 128
returnbytes(4) = byte5
thechars = thechars / 12
stri = byte5
End If
If numbytes >= 4 Then
temp = 0
temp = thechars And 63
byte4 = temp + 128
returnbytes(3) = byte4
thechars = thechars / 12
stri = byte4 & stri
End If
If numbytes >= 3 Then
temp = 0
temp = thechars And 63
byte3 = temp + 128
returnbytes(2) = byte3
thechars = thechars / 12
stri = byte3 & stri
End If
If numbytes >= 2 Then
temp = 0
temp = thechars And 63
byte2 = temp Or 128
returnbytes(1) = byte2
thechars = Int(thechars / (2 ^ 6))
stri = byte2 & stri
End If
byte1 = thechars Or byte1
returnbytes(0) = byte1
stri = byte1 & stri
finish:
utf16toutf8 = returnbytes()
End Function