Skip to content

Instantly share code, notes, and snippets.

@jvarn
Last active May 28, 2025 00:58
Show Gist options
  • Select an option

  • Save jvarn/5e11b1fd741b5f79d8a516c9c2368f17 to your computer and use it in GitHub Desktop.

Select an option

Save jvarn/5e11b1fd741b5f79d8a516c9c2368f17 to your computer and use it in GitHub Desktop.

Revisions

  1. jvarn revised this gist Aug 22, 2024. 2 changed files with 0 additions and 0 deletions.
  2. jvarn revised this gist Aug 22, 2024. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion excel-url-encode-decode_module.vb
    Original file line number Diff line number Diff line change
    @@ -1,4 +1,4 @@
    Option Explicit
    Option Explicit

    '------------------------------------------------------------------------------
    ' Module: URL Encode and Decode Functions
  3. jvarn revised this gist Aug 22, 2024. 2 changed files with 0 additions and 0 deletions.
    File renamed without changes.
  4. jvarn revised this gist Aug 22, 2024. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion excel-url-encode-decode.vb
    Original file line number Diff line number Diff line change
    @@ -3,7 +3,7 @@ Option Explicit
    '------------------------------------------------------------------------------
    ' Module: URL Encode and Decode Functions
    ' Author: Jeremy Varnham
    ' Version: 2.0.0
    ' Version: 1.1.0
    ' Date: 22 August 2024
    ' Description: This module provides two functions: URLEncode and URLDecode.
    ' These functions allow you to encode and decode URL strings,
  5. jvarn revised this gist Aug 22, 2024. 4 changed files with 184 additions and 83 deletions.
    16 changes: 16 additions & 0 deletions Changelog.md
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,16 @@
    # Changelog

    ## Version 1.1.0 - 22 August 2024

    1. Combined the two separate files for URLEncode and URLDecode into a single module to simplifies usage and maintenance.
    2. Added a comment block at the beginning of the module and each function.
    3. Improved the inline comments for enhanced readability and maintainability.
    4. Added error handling in both functions to catch and handle potential runtime errors.

    ## Version 1.0.1 - 2 March 2022

    1. Renamed URL_Encode function as URLEncode to match URLDecode

    ## Version 1.0.0
    Source: ExcelVBA.ru
    Original Source: zhaojunpeng.com (defunct)
    48 changes: 0 additions & 48 deletions excel-url-decode.vba
    Original file line number Diff line number Diff line change
    @@ -1,48 +0,0 @@
    Function URLDecode(ByVal strIn)
    On Error Resume Next
    Dim sl&, tl&, key$, kl&
    sl = 1: tl = 1: key = "%": kl = Len(key)
    sl = InStr(sl, strIn, key, 1)
    Do While sl > 0
    If (tl = 1 And sl <> 1) Or tl < sl Then
    URLDecode = URLDecode & Mid(strIn, tl, sl - tl)
    End If
    Dim hh$, hi$, hl$, a$
    Select Case UCase(Mid(strIn, sl + kl, 1))
    Case "U" 'Unicode URLEncode
    a = Mid(strIn, sl + kl + 1, 4)
    URLDecode = URLDecode & ChrW("&H" & a)
    sl = sl + 6
    Case "E" 'UTF-8 URLEncode
    hh = Mid(strIn, sl + kl, 2)
    a = Int("&H" & hh) 'ascii?
    If Abs(a) < 128 Then
    sl = sl + 3
    URLDecode = URLDecode & Chr(a)
    Else
    hi = Mid(strIn, sl + 3 + kl, 2)
    hl = Mid(strIn, sl + 6 + kl, 2)
    a = ("&H" & hh And &HF) * 2 ^ 12 Or ("&H" & hi And &H3F) * 2 ^ 6 Or ("&H" & hl And &H3F)
    If a < 0 Then a = a + 65536
    URLDecode = URLDecode & ChrW(a)
    sl = sl + 9
    End If
    Case Else 'Asc URLEncode
    hh = Mid(strIn, sl + kl, 2) '??
    a = Int("&H" & hh) 'ascii?

    If Abs(a) < 128 Then
    sl = sl + 3
    Else
    hi = Mid(strIn, sl + 3 + kl, 2) '??
    'a = Int("&H" & hh & hi) '?ascii?
    a = (Int("&H" & hh) - 194) * 64 + Int("&H" & hi)
    sl = sl + 6
    End If
    URLDecode = URLDecode & ChrW(a)
    End Select
    tl = sl
    sl = InStr(sl, strIn, key, 1)
    Loop
    URLDecode = URLDecode & Mid(strIn, tl)
    End Function
    168 changes: 168 additions & 0 deletions excel-url-encode-decode.vb
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,168 @@
    Option Explicit

    '------------------------------------------------------------------------------
    ' Module: URL Encode and Decode Functions
    ' Author: Jeremy Varnham
    ' Version: 2.0.0
    ' Date: 22 August 2024
    ' Description: This module provides two functions: URLEncode and URLDecode.
    ' These functions allow you to encode and decode URL strings,
    ' supporting ASCII, Unicode, and UTF-8 encoding.
    ' Usage:
    ' 1. Open your CSV file in Excel and save it as a Macro-Enabled Workbook.
    ' 2. Open Visual Basic Editor.
    ' 3. Insert a new Module.
    ' 4. Copy and paste this code into the code editor window.
    ' 5. Close Visual Basic Editor. In your worksheet, you will now have two
    ' new formulas available: URLEncode and URLDecode.
    '------------------------------------------------------------------------------

    '------------------------------------------------------------------------------
    ' Function: URLDecode
    ' Description: Decodes a URL-encoded string, supporting ASCII, Unicode, and UTF-8 encoding.
    ' Parameters:
    ' - strIn: The URL-encoded string to decode.
    ' Returns:
    ' - The decoded string.
    '------------------------------------------------------------------------------
    Function URLDecode(ByVal strIn As String) As String
    On Error GoTo ErrorHandler

    ' Declare and initialize variables
    Dim sl As Long, tl As Long
    Dim key As String, kl As Long
    Dim hh As String, hi As String, hl As String
    Dim a As Long

    ' Set the key to look for the percent symbol used in URL encoding
    key = "%"
    kl = Len(key)
    sl = 1: tl = 1

    ' Find the first occurrence of the key (percent symbol) in the input string
    sl = InStr(sl, strIn, key, vbTextCompare)

    ' Loop through the input string until no more percent symbols are found
    Do While sl > 0
    ' Add unprocessed characters to the result
    If (tl = 1 And sl <> 1) Or tl < sl Then
    URLDecode = URLDecode & Mid(strIn, tl, sl - tl)
    End If

    ' Determine the type of encoding (Unicode, UTF-8, or ASCII) and decode accordingly
    Select Case UCase(Mid(strIn, sl + kl, 1))
    Case "U" ' Unicode URL encoding (e.g., %uXXXX)
    a = Val("&H" & Mid(strIn, sl + kl + 1, 4)) ' Convert hex to decimal
    URLDecode = URLDecode & ChrW(a) ' Convert decimal to character
    sl = sl + 6 ' Move to the next character after the encoded sequence
    Case "E" ' UTF-8 URL encoding (e.g., %EXXX)
    hh = Mid(strIn, sl + kl, 2) ' Get the first two hex digits
    a = Val("&H" & hh) ' Convert hex to decimal
    If a < 128 Then
    sl = sl + 3 ' Move to the next character
    URLDecode = URLDecode & Chr(a) ' Convert to ASCII character
    Else
    ' For multibyte UTF-8 characters
    hi = Mid(strIn, sl + 3 + kl, 2) ' Get the next two hex digits
    hl = Mid(strIn, sl + 6 + kl, 2) ' Get the final two hex digits
    a = ((Val("&H" & hh) And &HF) * 2 ^ 12) Or ((Val("&H" & hi) And &H3F) * 2 ^ 6) Or (Val("&H" & hl) And &H3F)
    URLDecode = URLDecode & ChrW(a) ' Convert to a wide character
    sl = sl + 9 ' Move to the next character after the encoded sequence
    End If
    Case Else ' Standard ASCII URL encoding (e.g., %XX)
    hh = Mid(strIn, sl + kl, 2) ' Get the two hex digits
    a = Val("&H" & hh) ' Convert hex to decimal
    If a < 128 Then
    sl = sl + 3 ' Move to the next character
    Else
    hi = Mid(strIn, sl + 3 + kl, 2) ' Get the next two hex digits
    a = ((Val("&H" & hh) - 194) * 64) + Val("&H" & hi) ' Convert to a character code
    sl = sl + 6 ' Move to the next character after the encoded sequence
    End If
    URLDecode = URLDecode & ChrW(a) ' Convert to a wide character
    End Select

    ' Update the position of the last processed character
    tl = sl
    ' Find the next occurrence of the percent symbol
    sl = InStr(sl, strIn, key, vbTextCompare)
    Loop

    ' Append any remaining characters after the last percent symbol
    URLDecode = URLDecode & Mid(strIn, tl)
    Exit Function

    ErrorHandler:
    ' Display an error message if an error occurs
    MsgBox "An error occurred in URLDecode function: " & Err.Description, vbExclamation, "URLDecode Error"
    End Function

    '------------------------------------------------------------------------------
    ' Function: URLEncode
    ' Description: Encodes a string into a URL-encoded format, supporting ASCII, Unicode, and UTF-8 encoding.
    ' Parameters:
    ' - txt: The string to encode.
    ' Returns:
    ' - The URL-encoded string.
    '------------------------------------------------------------------------------
    Public Function URLEncode(ByRef txt As String) As String
    On Error GoTo ErrorHandler

    ' Declare and initialize variables
    Dim buffer As String
    Dim i As Long, c As Long, n As Long

    ' Initialize the buffer with enough space for the encoded string
    buffer = String$(Len(txt) * 12, "%")

    ' Loop through each character in the input string
    For i = 1 To Len(txt)
    ' Get the character code for the current character
    c = AscW(Mid$(txt, i, 1)) And 65535

    ' Determine if the character needs to be encoded or can be left as is
    Select Case c
    Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95 ' Unescaped characters: 0-9, A-Z, a-z, - . _ '
    n = n + 1
    Mid$(buffer, n) = ChrW(c) ' Add the character to the buffer
    Case Is <= 127 ' Escaped UTF-8 1 byte (U+0000 to U+007F) '
    n = n + 3
    Mid$(buffer, n - 2) = "%" ' Add the percent symbol
    Mid$(buffer, n - 1) = Right$("0" & Hex$(c), 2) ' Add the hex representation
    Case Is <= 2047 ' Escaped UTF-8 2 bytes (U+0080 to U+07FF) '
    n = n + 6
    Mid$(buffer, n - 5) = "%" ' Add the percent symbol
    Mid$(buffer, n - 4) = Right$("0" & Hex$(192 + (c \ 64)), 2) ' Add the first byte of the encoded character
    Mid$(buffer, n - 2) = "%" ' Add the percent symbol
    Mid$(buffer, n - 1) = Right$("0" & Hex$(128 + (c Mod 64)), 2) ' Add the second byte of the encoded character
    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$(txt, i, 1)) And 1023)
    n = n + 12
    Mid$(buffer, n - 11) = "%" ' Add the percent symbol
    Mid$(buffer, n - 10) = Right$("0" & Hex$(240 + (c \ 262144)), 2) ' Add the first byte
    Mid$(buffer, n - 8) = "%" ' Add the percent symbol
    Mid$(buffer, n - 7) = Right$("0" & Hex$(128 + ((c \ 4096) Mod 64)), 2) ' Add the second byte
    Mid$(buffer, n - 5) = "%" ' Add the percent symbol
    Mid$(buffer, n - 4) = Right$("0" & Hex$(128 + ((c \ 64) Mod 64)), 2) ' Add the third byte
    Mid$(buffer, n - 2) = "%" ' Add the percent symbol
    Mid$(buffer, n - 1) = Right$("0" & Hex$(128 + (c Mod 64)), 2) ' Add the fourth byte
    Case Else ' Escaped UTF-8 3 bytes (U+0800 to U+FFFF) '
    n = n + 9
    Mid$(buffer, n - 8) = "%" ' Add the percent symbol
    Mid$(buffer, n - 7) = Right$("0" & Hex$(224 + (c \ 4096)), 2) ' Add the first byte
    Mid$(buffer, n - 5) = "%" ' Add the percent symbol
    Mid$(buffer, n - 4) = Right$("0" & Hex$(128 + ((c \ 64) Mod 64)), 2) ' Add the second byte
    Mid$(buffer, n - 2) = "%" ' Add the percent symbol
    Mid$(buffer, n - 1) = Right$("0" & Hex$(128 + (c Mod 64)), 2) ' Add the third byte
    End Select
    Next

    ' Trim the buffer to the actual length of the encoded string
    URLEncode = Left$(buffer, n)
    Exit Function

    ErrorHandler:
    ' Display an error message if an error occurs
    MsgBox "An error occurred in URLEncode function: " & Err.Description, vbExclamation, "URLEncode Error"
    End Function
    35 changes: 0 additions & 35 deletions excel-url-encode.vba
    Original file line number Diff line number Diff line change
    @@ -1,35 +0,0 @@
    Public Function URLEncode(ByRef txt As String) As String
    Dim buffer As String, i As Long, c As Long, n As Long
    buffer = String$(Len(txt) * 12, "%")

    For i = 1 To Len(txt)
    c = AscW(Mid$(txt, 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$(txt, 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
    URLEncode = Left$(buffer, n)
    End Function
  6. jvarn created this gist Mar 2, 2022.
    48 changes: 48 additions & 0 deletions excel-url-decode.vba
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,48 @@
    Function URLDecode(ByVal strIn)
    On Error Resume Next
    Dim sl&, tl&, key$, kl&
    sl = 1: tl = 1: key = "%": kl = Len(key)
    sl = InStr(sl, strIn, key, 1)
    Do While sl > 0
    If (tl = 1 And sl <> 1) Or tl < sl Then
    URLDecode = URLDecode & Mid(strIn, tl, sl - tl)
    End If
    Dim hh$, hi$, hl$, a$
    Select Case UCase(Mid(strIn, sl + kl, 1))
    Case "U" 'Unicode URLEncode
    a = Mid(strIn, sl + kl + 1, 4)
    URLDecode = URLDecode & ChrW("&H" & a)
    sl = sl + 6
    Case "E" 'UTF-8 URLEncode
    hh = Mid(strIn, sl + kl, 2)
    a = Int("&H" & hh) 'ascii?
    If Abs(a) < 128 Then
    sl = sl + 3
    URLDecode = URLDecode & Chr(a)
    Else
    hi = Mid(strIn, sl + 3 + kl, 2)
    hl = Mid(strIn, sl + 6 + kl, 2)
    a = ("&H" & hh And &HF) * 2 ^ 12 Or ("&H" & hi And &H3F) * 2 ^ 6 Or ("&H" & hl And &H3F)
    If a < 0 Then a = a + 65536
    URLDecode = URLDecode & ChrW(a)
    sl = sl + 9
    End If
    Case Else 'Asc URLEncode
    hh = Mid(strIn, sl + kl, 2) '??
    a = Int("&H" & hh) 'ascii?

    If Abs(a) < 128 Then
    sl = sl + 3
    Else
    hi = Mid(strIn, sl + 3 + kl, 2) '??
    'a = Int("&H" & hh & hi) '?ascii?
    a = (Int("&H" & hh) - 194) * 64 + Int("&H" & hi)
    sl = sl + 6
    End If
    URLDecode = URLDecode & ChrW(a)
    End Select
    tl = sl
    sl = InStr(sl, strIn, key, 1)
    Loop
    URLDecode = URLDecode & Mid(strIn, tl)
    End Function
    35 changes: 35 additions & 0 deletions excel-url-encode.vba
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,35 @@
    Public Function URLEncode(ByRef txt As String) As String
    Dim buffer As String, i As Long, c As Long, n As Long
    buffer = String$(Len(txt) * 12, "%")

    For i = 1 To Len(txt)
    c = AscW(Mid$(txt, 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$(txt, 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
    URLEncode = Left$(buffer, n)
    End Function