How can I URL encode a string in Excel VBA?

Question

Is there a built-in way to URL encode a string in Excel VBA or do I need to hand roll this functionality?

Tomalak · Accepted Answer · 2018-08-16T13:12:00.387

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 If
End 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 = TempAns
End 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 If
End Function

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

I used your "more efficient (~2× as fast) version" and it works a treat! Thank you. — Chris Jacob, Jun 01 '12 at 04:17
@Chris Thanks. :) Note that you can probably make an UTF-8-compliant version if you use an `ADODB.Stream` object, which can do the necessary string conversion. Samples how to produce UTF-8 with VBA or VBScript are all over the Internet. — Tomalak, Jun 01 '12 at 07:01
if performance is an issue - consider refactoring to use "replace" by cycling through integer 0 to 255 and doing something like: Case 0 To 36, 38 To 47, 58 To 64, 91 To 96, 123 To 255 str_Input = Replace(str_Input, Chr(int_char_num), "%" & Right("0" & Hex(255), 2)) — spioter, Aug 28 '13 at 16:15
That would actually do the opposite. VB strings are immutable, doing a replace 255 times on one allocates a new, complete string with every step of the iteration. That's certainly more wasteful in terms of space and memory than assigning letters to a pre-allocated array. — Tomalak, Aug 28 '13 at 17:14
This code will stop on a Unicode error in Access 2013, because it both handles too many and too few characters at the same time. — Henrik Erlandsson, Mar 02 '20 at 13:30
@HenrikErlandsson Can you give me the value you've tried it with, I'll try and reproduce the issue. — Tomalak, Mar 02 '20 at 13:33
@HenrikErlandsson I've just tested with a CJK character (inside the BMP) and the "pile of poo" character (outside the BMP), and the output is correct in both cases. Still not sure what you did, I can't seem to produce a Unicode error. — Tomalak, Mar 03 '20 at 13:33
The first function (With utf-support) did not work in access-vba because of problems with the borders of the arrays. So I changed it to: ReDim result(LBound(bytes) To UBound(bytes)) As String For i = UBound(bytes) To LBound(bytes) Step -1 — Gener4tor, Dec 23 '21 at 11:02

score 70 · Answer 2 · edited Feb 25 '19 at 14:37

70

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

edited Feb 25 '19 at 14:37

aetonsi

208
2
9

answered Jun 19 '14 at 07:47

Jamie Bull

12,889
15
77
116

It fails for me when having to encode csv data with consecutive commas in the field.. had to use the above utf8 version in the answer – Salman Siddique Apr 10 '18 at 21:04
@SalmanSiddique good to know the limitations. Might be worth saying which of the utf8 versions you used as there are more than one – Jamie Bull Apr 11 '18 at 10:32
`Application.WorksheetFunction.EncodeUrl(myString)` worked perfectly for my needs - hopefully this answer will be upvoted enough to supersede the previous, mega-old version – jamheadart Feb 25 '19 at 10:45
@jamheadart to be fair, this answer is linked to in the first line of the accepted answer – Jamie Bull Feb 25 '19 at 14:42
2

That is fair. I didn't notice it. I saw the immense amount of code and the date and figured there'd be a better answer further down! – jamheadart Feb 25 '19 at 15:31

score 35 · Answer 3 · edited Feb 06 '20 at 05:06

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 If

Public Function UTF16To8(ByVal UTF16 As String) As String
Dim sBuffer As String
Dim lLength As Long
If 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 If
End Function

Public Function URLEncode( _
   StringVal As String, _
   Optional SpaceAsPlus As Boolean = False, _
   Optional UTF8Encode As Boolean = True _
) As String

Dim 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 If
End Function

Enjoy!

Referring to 'the above' in an answer that may well rise or sink depending on the number of votes, is not useful. — cometbill, Jan 20 '14 at 09:37
Nice solution, but has one bug - parentheses are actually allowed in urls... So we added another Case statement for ( =40 and ) = 41 ```` Case 0 To 15 Result(I) = "%0" & Hex(CharCode) ' leave parentheses () as they are Case 40 To 41 Result(I) = Char Case Else Result(I) = "%" & Hex(CharCode) ```` — Alexander Marek, Mar 10 '22 at 10:38

score 19 · Answer 4 · edited May 23 '17 at 12:02

19

Although, this one is very old. I have come up with a solution based in this answer:

Dim ScriptEngine As ScriptControl
Set ScriptEngine = New ScriptControl
ScriptEngine.Language = "JScript"

ScriptEngine.AddCode "function encode(str) {return encodeURIComponent(str);}"
Dim encoded As String
encoded = ScriptEngine.Run("encode", "€ömE.sdfds")

Add Microsoft Script Control as reference and you are done.

Just a side note, because of the JS part, this is fully UTF-8-compatible. VB will convert correctly from UTF-16 to UTF-8.

edited May 23 '17 at 12:02

Community

1
1

answered Aug 28 '12 at 11:13

Michael-O

18,123
6
55
121

1

Awesome, I didn't know you could use JS code in VBA. My whole world is opening up now. – livefree75 Sep 23 '13 at 14:25
1

Great. It was just what I need. Remark: If you do not want to add a reference, you can: A) Dim ScriptEngine As Object B) Set ScriptEngine = CreateObject("scriptcontrol"). By the way, instead of creating a function in JS, it seems you can call the encodeURIComponent straight away like so: encoded = ScriptEngine.Run("encodeURIComponent", str) – El Scripto Mar 07 '15 at 07:50
@ElScripto, go ahead and post an improved answer which refers to mine. – Michael-O Mar 07 '15 at 12:32
1

ScriptControl won't work on 64-bit Office versions, check [solution via `htmlfile` ActiveX](http://stackoverflow.com/a/34601029/2165759) and [workaround getting ScriptControl to work with Excel x64](http://stackoverflow.com/a/38134477/2165759). – omegastripes Feb 26 '17 at 16:13

score 17 · Answer 5 · answered Mar 08 '15 at 07:10

17

Similar to Michael-O's code, only without need to reference (late bind) and with less one line .
* I read, that in excel 2013 it can be done more easily like so: WorksheetFunction.EncodeUrl(InputString)

Public Function encodeURL(str As String)
    Dim ScriptEngine As Object
    Dim encoded As String

    Set ScriptEngine = CreateObject("scriptcontrol")
    ScriptEngine.Language = "JScript"

    encoded = ScriptEngine.Run("encodeURIComponent", str)

    encodeURL = encoded
End Function

answered Mar 08 '15 at 07:10

El Scripto

576
5
8

1

ScriptControl won't work on 64-bit Office versions, check [solution via `htmlfile` ActiveX](http://stackoverflow.com/a/34601029/2165759) and [workaround getting ScriptControl to work with Excel x64](http://stackoverflow.com/a/38134477/2165759). – omegastripes Feb 26 '17 at 16:14

ozmike · Answer 6 · 2018-05-30T04:26:01.673

13

Since office 2013 use this inbuilt function here.

If before office 2013

Function encodeURL(str As String)
Dim ScriptEngine As ScriptControl
Set ScriptEngine = New ScriptControl
ScriptEngine.Language = "JScript"

ScriptEngine.AddCode "function encode(str) {return encodeURIComponent(str);}"
Dim encoded As String


encoded = ScriptEngine.Run("encode", str)
encodeURL = encoded
End Function

Add Microsoft Script Control as reference and you are done.

Same as last post just complete function ..works!

edited May 30 '18 at 04:26

answered Jan 24 '13 at 07:22

ozmike

2,738
1
33
40

Done. Ok I didn't know I could edit and you don't get points for edits unfortunately! – ozmike Jan 15 '14 at 06:35
1

FYI I tried to update the other post but my edits get moderated! eg. Micha reviewed this 18 hours ago: Reject This edit is incorrect or an attempt to reply to or comment on the existing post. alex2410 reviewed this 18 hours ago: Reject This edit is incorrect or an attempt to reply to or comment on the existing post. bansi reviewed this 18 hours ago: Reject This edit is incorrect or an attempt to reply to or comment on the existing post. - – ozmike Jan 16 '14 at 00:44
ScriptControl won't work on 64-bit Office versions, check [solution via `htmlfile` ActiveX](http://stackoverflow.com/a/34601029/2165759) and [workaround getting ScriptControl to work with Excel x64](http://stackoverflow.com/a/38134477/2165759). – omegastripes Feb 26 '17 at 16:13

score 7 · Answer 7 · answered Jan 04 '16 at 22:28

7

One more solution via htmlfile ActiveX:

Function EncodeUriComponent(strText)
    Static objHtmlfile As Object
    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
    End If
    EncodeUriComponent = objHtmlfile.parentWindow.encode(strText)
End Function

Declaring htmlfile DOM document object as static variable gives the only small delay when called first time due to init, and makes this function very fast for numerous calls, e. g. for me it converts the string of 100 chars length 100000 times in 2 seconds approx..

answered Jan 04 '16 at 22:28

omegastripes

12,351
4
45
96

Upvote for static. It's a brilliant idea to use it with late binding sub-procedures and functions, which are called multiple times, to speed things up. – Ryszard Jędraszyk Feb 26 '17 at 05:43
1

@RyszardJędraszyk `Static` can be used with early binding as well for the same purpose. – omegastripes Mar 25 '17 at 11:26

Joshua Honig · Answer 8 · 2013-06-11T21:03:55.133

(Bump on an old thread). Just for kicks, here's a version that uses pointers to assemble the result string. It's about 2x - 4x as fast as the faster second version in the accepted answer.

Public Declare PtrSafe Sub Mem_Copy Lib "kernel32" _
    Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Public Declare PtrSafe Sub Mem_Read2 Lib "msvbvm60" _
    Alias "GetMem2" (ByRef Source As Any, ByRef Destination As Any)

Public Function URLEncodePart(ByRef RawURL As String) As String

    Dim pChar As LongPtr, iChar As Integer, i As Long
    Dim strHex As String, pHex As LongPtr
    Dim strOut As String, pOut As LongPtr
    Dim pOutStart As LongPtr, pLo As LongPtr, pHi As LongPtr
    Dim lngLength As Long
    Dim cpyLength As Long
    Dim iStart As Long

    pChar = StrPtr(RawURL)
    If pChar = 0 Then Exit Function

    lngLength = Len(RawURL)
    strOut = Space(lngLength * 3)
    pOut = StrPtr(strOut)
    pOutStart = pOut
    strHex = "0123456789ABCDEF"
    pHex = StrPtr(strHex)

    iStart = 1
    For i = 1 To lngLength
        Mem_Read2 ByVal pChar, iChar
        Select Case iChar
            Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
              ' Ok
            Case Else
                If iStart < i Then
                    cpyLength = (i - iStart) * 2
                    Mem_Copy ByVal pOut, ByVal pChar - cpyLength, cpyLength
                    pOut = pOut + cpyLength
                End If

                pHi = pHex + ((iChar And &HF0) / 8)
                pLo = pHex + 2 * (iChar And &HF)

                Mem_Read2 37, ByVal pOut
                Mem_Read2 ByVal pHi, ByVal pOut + 2
                Mem_Read2 ByVal pLo, ByVal pOut + 4
                pOut = pOut + 6

                iStart = i + 1
        End Select
        pChar = pChar + 2
    Next

    If iStart <= lngLength Then
        cpyLength = (lngLength - iStart + 1) * 2
        Mem_Copy ByVal pOut, ByVal pChar - cpyLength, cpyLength
        pOut = pOut + cpyLength
    End If

    URLEncodePart = Left$(strOut, (pOut - pOutStart) / 2)

End Function

score 3 · Answer 9 · answered Mar 27 '18 at 00:06

Same as WorksheetFunction.EncodeUrl with UTF-8 support:

Public Function EncodeURL(url As String) As String
  Dim buffer As String, i As Long, c As Long, n As Long
  buffer = String$(Len(url) * 12, "%")

  For i = 1 To Len(url)
    c = AscW(Mid$(url, i, 1)) And 65535

    Select Case c
      Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95  ' Unescaped 0-9A-Za-z-._ '
        n = n + 1
        Mid$(buffer, n) = ChrW(c)
      Case Is <= 127            ' Escaped UTF-8 1 bytes U+0000 to U+007F '
        n = n + 3
        Mid$(buffer, n - 1) = Right$(Hex$(256 + c), 2)
      Case Is <= 2047           ' Escaped UTF-8 2 bytes U+0080 to U+07FF '
        n = n + 6
        Mid$(buffer, n - 4) = Hex$(192 + (c \ 64))
        Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
      Case 55296 To 57343       ' Escaped UTF-8 4 bytes U+010000 to U+10FFFF '
        i = i + 1
        c = 65536 + (c Mod 1024) * 1024 + (AscW(Mid$(url, i, 1)) And 1023)
        n = n + 12
        Mid$(buffer, n - 10) = Hex$(240 + (c \ 262144))
        Mid$(buffer, n - 7) = Hex$(128 + ((c \ 4096) Mod 64))
        Mid$(buffer, n - 4) = Hex$(128 + ((c \ 64) Mod 64))
        Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
      Case Else                 ' Escaped UTF-8 3 bytes U+0800 to U+FFFF '
        n = n + 9
        Mid$(buffer, n - 7) = Hex$(224 + (c \ 4096))
        Mid$(buffer, n - 4) = Hex$(128 + ((c \ 64) Mod 64))
        Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
    End Select
  Next

  EncodeURL = Left$(buffer, n)
End Function

Henrik Erlandsson · Answer 10 · 2020-03-02T15:06:14.833

The accepted answer's code stopped on a Unicode error in Access 2013, so I wrote a function for myself with high readability that should follow RFC 3986 according to Davis Peixoto, and cause minimal trouble in various environments.

Note: The percent sign itself must be replaced first, or it will double-encode any previously encoded characters. Replacing space with + was added, not to conform with RFC 3986, but to provide links that don't break due to formatting. It is optional.

Public Function URLEncode(str As Variant) As String
    Dim i As Integer, sChar() As String, sPerc() As String
    sChar = Split("%|!|*|'|(|)|;|:|@|&|=|+|$|,|/|?|#|[|]| ", "|")
    sPerc = Split("%25 %21 %2A %27 %28 %29 %3B %3A %40 %26 %3D %2B %24 %2C %2F %3F %23 %5B %5D +", " ")
    URLEncode = Nz(str)
    For i = 0 To 19
        URLEncode = Replace(URLEncode, sChar(i), sPerc(i))
    Next i
End Function

score 0 · Answer 11 · answered Mar 06 '14 at 11:26

If you also want it to work on MacOs create a seperate function

Function macUriEncode(value As String) As String

    Dim script As String
    script = "do shell script " & """/usr/bin/python -c 'import sys, urllib; print urllib.quote(sys.argv[1])' """ & Chr(38) & " quoted form of """ & value & """"

    macUriEncode = MacScript(script)

End Function

ndd · Answer 12 · 2015-09-17T07:50:51.077

I had problem with encoding cyrillic letters to URF-8.

I modified one of the above scripts to match cyrillic char map. Implmented is the cyrrilic section of

https://en.wikipedia.org/wiki/UTF-8 and http://www.utf8-chartable.de/unicode-utf8-table.pl?start=1024

Other sections development is sample and need verification with real data and calculate the char map offsets

Here is the script:

Public Function UTF8Encode( _
   StringToEncode As String, _
   Optional UsePlusRatherThanHexForSpace As Boolean = False _
) As String

  Dim TempAns As String
  Dim TempChr As Long
  Dim CurChr As Long
  Dim Offset As Long
  Dim TempHex As String
  Dim CharToEncode As Long
  Dim TempAnsShort As String

  CurChr = 1

  Do Until CurChr - 1 = Len(StringToEncode)
    CharToEncode = Asc(Mid(StringToEncode, CurChr, 1))
' http://www.utf8-chartable.de/unicode-utf8-table.pl?start=1024
' as per https://en.wikipedia.org/wiki/UTF-8 specification the engoding is as follows

    Select Case CharToEncode
'   7   U+0000 U+007F 1 0xxxxxxx
      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 0 To &H7F
            TempAns = TempAns + "%" + Hex(CharToEncode And &H7F)
      Case &H80 To &H7FF
'   11  U+0080 U+07FF 2 110xxxxx 10xxxxxx
' The magic is in offset calculation... there are different offsets between UTF-8 and Windows character maps
' offset 192 = &HC0 = 1100 0000 b  added to start of UTF-8 cyrillic char map at &H410
          CharToEncode = CharToEncode - 192 + &H410
          TempAnsShort = "%" & Right("0" & Hex((CharToEncode And &H3F) Or &H80), 2)
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H40) And &H1F) Or &HC0), 2) & TempAnsShort
          TempAns = TempAns + TempAnsShort

'' debug and development version
''          CharToEncode = CharToEncode - 192 + &H410
''          TempChr = (CharToEncode And &H3F) Or &H80
''          TempHex = Hex(TempChr)
''          TempAnsShort = "%" & Right("0" & TempHex, 2)
''          TempChr = ((CharToEncode And &H7C0) / &H40) Or &HC0
''          TempChr = ((CharToEncode \ &H40) And &H1F) Or &HC0
''          TempHex = Hex(TempChr)
''          TempAnsShort = "%" & Right("0" & TempHex, 2) & TempAnsShort
''          TempAns = TempAns + TempAnsShort

      Case &H800 To &HFFFF
'   16 U+0800 U+FFFF 3 1110xxxx 10xxxxxx 10xxxxxx
' not tested . Doesnot match Case condition... very strange
        MsgBox ("Char to encode  matched U+0800 U+FFFF: " & CharToEncode & " = &H" & Hex(CharToEncode))
''          CharToEncode = CharToEncode - 192 + &H410
          TempAnsShort = "%" & Right("0" & Hex((CharToEncode And &H3F) Or &H80), 2)
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H40) And &H3F) Or &H80), 2) & TempAnsShort
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H1000) And &HF) Or &HE0), 2) & TempAnsShort
          TempAns = TempAns + TempAnsShort

      Case &H10000 To &H1FFFFF
'   21 U+10000 U+1FFFFF 4 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
''        MsgBox ("Char to encode  matched &H10000 &H1FFFFF: " & CharToEncode & " = &H" & Hex(CharToEncode))
' sample offset. tobe verified
          CharToEncode = CharToEncode - 192 + &H410
          TempAnsShort = "%" & Right("0" & Hex((CharToEncode And &H3F) Or &H80), 2)
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H40) And &H3F) Or &H80), 2) & TempAnsShort
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H1000) And &H3F) Or &H80), 2) & TempAnsShort
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H40000) And &H7) Or &HF0), 2) & TempAnsShort
          TempAns = TempAns + TempAnsShort

      Case &H200000 To &H3FFFFFF
'   26  U+200000 U+3FFFFFF 5 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
''        MsgBox ("Char to encode  matched U+200000 U+3FFFFFF: " & CharToEncode & " = &H" & Hex(CharToEncode))
' sample offset. tobe verified
          CharToEncode = CharToEncode - 192 + &H410
          TempAnsShort = "%" & Right("0" & Hex((CharToEncode And &H3F) Or &H80), 2)
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H40) And &H3F) Or &H80), 2) & TempAnsShort
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H1000) And &H3F) Or &H80), 2) & TempAnsShort
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H40000) And &H3F) Or &H80), 2) & TempAnsShort
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H1000000) And &H3) Or &HF8), 2) & TempAnsShort
          TempAns = TempAns + TempAnsShort

      Case &H4000000 To &H7FFFFFFF
'   31  U+4000000 U+7FFFFFFF 6 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
''        MsgBox ("Char to encode  matched U+4000000 U+7FFFFFFF: " & CharToEncode & " = &H" & Hex(CharToEncode))
' sample offset. tobe verified
          CharToEncode = CharToEncode - 192 + &H410
          TempAnsShort = "%" & Right("0" & Hex((CharToEncode And &H3F) Or &H80), 2)
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H40) And &H3F) Or &H80), 2) & TempAnsShort
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H1000) And &H3F) Or &H80), 2) & TempAnsShort
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H40000) And &H3F) Or &H80), 2) & TempAnsShort
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H1000000) And &H3F) Or &H80), 2) & TempAnsShort
          TempAnsShort = "%" & Right("0" & Hex(((CharToEncode \ &H40000000) And &H1) Or &HFC), 2) & TempAnsShort
          TempAns = TempAns + TempAnsShort

      Case Else
' somethig else
' to be developped
        MsgBox ("Char to encode not matched: " & CharToEncode & " = &H" & Hex(CharToEncode))

    End Select

    CurChr = CurChr + 1
  Loop

  UTF8Encode = TempAns
End Function

Good luck!

Jimit Rupani · Answer 13 · 2015-12-09T09:48:58.467

This snippet i have used in my application to encode the URL so may this can help you to do the same.

Function URLEncode(ByVal str As String) As String
        Dim intLen As Integer
        Dim x As Integer
        Dim curChar As Long
        Dim newStr As String
        intLen = Len(str)
        newStr = ""

        For x = 1 To intLen
            curChar = Asc(Mid$(str, x, 1))

            If (curChar < 48 Or curChar > 57) And _
                (curChar < 65 Or curChar > 90) And _
                (curChar < 97 Or curChar > 122) Then
                                newStr = newStr & "%" & Hex(curChar)
            Else
                newStr = newStr & Chr(curChar)
            End If
        Next x

        URLEncode = newStr
    End Function

score 0 · Answer 14 · edited Mar 06 '18 at 17:05

None of the solutions here worked for me out of the box, but it was most likely due my lack of experience with VBA. It might also be because I simply copied and pasted some of the functions above, not knowing details that maybe are necessary to make them work on a VBA for applications environment.

My needs were simply to send xmlhttp requests using urls that contained some special characters of the Norwegian language. Some of the solutions above encode even colons, which made the urls unsuitable for what I needed.

I then decided to write my own URLEncode function. It does not use more clever programming such as the one from @ndd and @Tom. I am not a very experienced programmer, but I had to make this done sooner.

I realized that the problem was that my server didn't accept UTF-16 encodings, so I had to write a function that would convert UTF-16 to UTF-8. A good source of information was found here and here.

I haven't tested it extensively to check if it works with url with characters that have higher unicode values and which would produce more than 2 bytes of utf-8 characters. I am not saying it will decode everything that needs to be decoded (but it is easy to modify to include/exclude characters on the select case statement) nor that it will work with higher characters, as I haven't fully tested. But I am sharing the code because it might help someone who is trying to understand the issue.

Any comments are welcome.

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

score 0 · Answer 15 · answered Nov 13 '18 at 23:49

0

The VBA-tools library has a function for that:

http://vba-tools.github.io/VBA-Web/docs/#/WebHelpers/UrlEncode

It seems to work similar to encodeURIComponent() in JavaScript.

answered Nov 13 '18 at 23:49

ADJenks

2,973
27
38

Excel Hero · Answer 16 · 2022-04-07T03:33:29.280

The best of both worlds. This function uses the new(ish) worksheet function ENCODEURL() if the workbook is open in Excel 2013 or newer.

If it's an older version of Excel then this function uses htmlfile instead.

You can also force this function to use htmlfile by passing True as the optional bForceOldSchool argument.

Function URLEncode$(s$, Optional bForceOldSchool As Boolean)
  Select Case True
    Case bForceOldSchool Or Val(Application.Version) < 15
               URLEncode = CreateObject("htmlfile").parentWindow.EncodeUriComponent(s)
    Case Else: URLEncode = WorksheetFunction.EncodeURL(s)
  End Select
End Function

How can I URL encode a string in Excel VBA?

16 Answers16

Linked