How can I URL encode a string in Excel VBA? How can I URL encode a string in Excel VBA? vba vba

How can I URL encode a string in Excel VBA?


No, nothing built-in (until Excel 2013 - see this answer).

There are three versions of URLEncode() in this answer.

  • A function with UTF-8 support. You should probably use this one (or the alternative implementation by Tom) for compatibility with modern requirements.
  • For reference and educational purposes, two functions without UTF-8 support:
    • one found on a third party website, included as-is. (This was the first version of the answer)
    • one optimized version of that, written by me

A variant that supports UTF-8 encoding and is based on ADODB.Stream (include a reference to a recent version of the "Microsoft ActiveX Data Objects" library in your project):

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 IfEnd Function

This function was found on 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 = TempAnsEnd Function

I've corrected a little bug that was in there.


I would use more efficient (~2× as fast) version of the above:

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 IfEnd Function

Note that neither of these two functions support UTF-8 encoding.


For the sake of bringing this up to date, since Excel 2013 there is now a built-in way of encoding URLs using the worksheet function ENCODEURL.

To use it in your VBA code you just need to call

EncodedUrl = WorksheetFunction.EncodeUrl(InputString)

Documentation


Version of the above supporting UTF8:

Private Const CP_UTF8 = 65001#If VBA7 Then  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 Long, _    ByVal lpUsedDefaultChar As Long _    ) 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 IfPublic Function UTF16To8(ByVal UTF16 As String) As StringDim sBuffer As StringDim lLength As LongIf UTF16 <> "" Then    #If VBA7 Then        lLength = WideCharToMultiByte(CP_UTF8, 0, CLngPtr(StrPtr(UTF16)), -1, 0, 0, 0, 0)    #Else        lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, 0, 0, 0, 0)    #End If    sBuffer = Space$(lLength)    #If VBA7 Then        lLength = WideCharToMultiByte(CP_UTF8, 0, CLngPtr(StrPtr(UTF16)), -1, CLngPtr(StrPtr(sBuffer)), LenB(sBuffer), 0, 0)    #Else        lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, StrPtr(sBuffer), LenB(sBuffer), 0, 0)    #End If    sBuffer = StrConv(sBuffer, vbUnicode)    UTF16To8 = Left$(sBuffer, lLength - 1)Else    UTF16To8 = ""End IfEnd FunctionPublic Function URLEncode( _   StringVal As String, _   Optional SpaceAsPlus As Boolean = False, _   Optional UTF8Encode As Boolean = True _) As StringDim StringValCopy As String: StringValCopy = IIf(UTF8Encode, UTF16To8(StringVal), StringVal)Dim StringLen As Long: StringLen = Len(StringValCopy)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$(StringValCopy, 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 IfEnd Function

Enjoy!