Нет, ничего встроенного ( до Excel 2013 - см. Этот ответ ).
В этом ответе есть три версии URLEncode().
- Функция с поддержкой UTF-8. Вероятно, вам следует использовать этот (или альтернативная реализация от Tom) для совместимости с современными требованиями.
- Для справочных и образовательных целей две функции без поддержки UTF-8:
- один найден на стороннем веб-сайте, включен как есть. (Это был первый вариант ответа)
- одна оптимизированная версия, написанная мной
Вариант, который поддерживает кодировку UTF-8 и основан на ADODB.Stream (включая ссылку на последнюю версию библиотеки «Объекты данных Microsoft ActiveX» в вашем проекте):
Public Function URLEncode( _
ByVal StringVal As String, _
Optional SpaceAsPlus As Boolean = False _
) As String
Dim bytes() As Byte, b As Byte, i As Integer, space As String
If SpaceAsPlus Then space = "+" Else space = "%20"
If Len(StringVal) > 0 Then
With New ADODB.Stream
.Mode = adModeReadWrite
.Type = adTypeText
.Charset = "UTF-8"
.Open
.WriteText StringVal
.Position = 0
.Type = adTypeBinary
.Position = 3 ' skip BOM
bytes = .Read
End With
ReDim result(UBound(bytes)) As String
For i = UBound(bytes) To 0 Step -1
b = bytes(i)
Select Case b
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = Chr(b)
Case 32
result(i) = space
Case 0 To 15
result(i) = "%0" & Hex(b)
Case Else
result(i) = "%" & Hex(b)
End Select
Next i
URLEncode = Join(result, "")
End If
End Function
Эта функция была найдена на freevbcode.com :
Public Function URLEncode( _
StringToEncode As String, _
Optional UsePlusRatherThanHexForSpace As Boolean = False _
) As String
Dim TempAns As String
Dim CurChr As Integer
CurChr = 1
Do Until CurChr - 1 = Len(StringToEncode)
Select Case Asc(Mid(StringToEncode, CurChr, 1))
Case 48 To 57, 65 To 90, 97 To 122
TempAns = TempAns & Mid(StringToEncode, CurChr, 1)
Case 32
If UsePlusRatherThanHexForSpace = True Then
TempAns = TempAns & "+"
Else
TempAns = TempAns & "%" & Hex(32)
End If
Case Else
TempAns = TempAns & "%" & _
Right("0" & Hex(Asc(Mid(StringToEncode, _
CurChr, 1))), 2)
End Select
CurChr = CurChr + 1
Loop
URLEncode = TempAns
End Function
Я исправил небольшую ошибку, которая была там.
Я бы использовал более эффективную (примерно в 2 раза быстрее) версию выше:
Public Function URLEncode( _
StringVal As String, _
Optional SpaceAsPlus As Boolean = False _
) As String
Dim StringLen As Long: StringLen = Len(StringVal)
If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String, Space As String
If SpaceAsPlus Then Space = "+" Else Space = "%20"
For i = 1 To StringLen
Char = Mid$(StringVal, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = Char
Case 32
result(i) = Space
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next i
URLEncode = Join(result, "")
End If
End Function
Обратите внимание, что ни одна из этих двух функций не поддерживает кодировку UTF-8.