In my previous article
VBA - URL Encode, URI Encode
After presenting a couple recent articles on mapping in which we build up a URL and then needed to replace certain characters to make it compatible with Google/Bing… I thought I’d share a couple functions that can do this more efficiently and perform URL/URI encoding and decoding.
I demonstrated how we could easily encode a URI/URL, taking
https://www.bing.com/maps/?v=2&where1=Mount Rushmore National Memorial,13000 SD Highway 244, Keystone, SD, United States
and, depending on the technique used, returning
https://www.bing.com/maps/?v=2&where1=Mount%20Rushmore%20National%20Memorial,13000%20SD%20Highway%20244,%20Keystone,%20SD,%20United%20States
or
https%3A%2F%2Fwww.bing.com%2Fmaps%2F%3Fv%3D2%26where1%3DMount%20Rushmore%20National%20Memorial%2C13000%20SD%20Highway%20244%2C%20Keystone%2C%20SD%2C%20United%20States
Today, I thought it wise to explore how we can do the inverse, that is decode and HTML URI/URL back to plain text.
As with encoding, there are a number of ways that this can be approached and today I will present 3:
You’ll no doubt notice that both the script control and HTML file approaches work in extremely similar manners.
These only uses basic VBA code or built-in functions, uses no references and thus are bitness independent (so it will run equally on 32 or 64-bit installations).
Using the Script Control Object
Decoding
Public Function SC_decodeURI(ByVal sURI As String) As String
On Error GoTo Error_Handler
Dim oScriptControl As Object
Set oScriptControl = CreateObject("ScriptControl")
With oScriptControl
.Language = "JScript"
SC_decodeURI = .Run("decodeURI", sURI)
End With
Error_Handler_Exit:
On Error Resume Next
Set oScriptControl = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: SC_decodeURI" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
End Function
Public Function SC_decodeURIComponent(ByVal sURI As String) As String
On Error GoTo Error_Handler
Dim oScriptControl As Object
Set oScriptControl = CreateObject("ScriptControl")
With oScriptControl
.Language = "JScript"
SC_decodeURIComponent = .Run("decodeURIComponent", sURI)
End With
Error_Handler_Exit:
On Error Resume Next
Set oScriptControl = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: SC_decodeURIComponent" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
End Function
Using the HTML File Object
Decoding
Function HF_decodeURI(ByVal sURI As String)
HF_decodeURI = CreateObject("HTMLFile").parentWindow.decodeURI(sURI)
End Function
Function HF_decodeURIComponent(ByVal sURI As String)
HF_decodeURIComponent = CreateObject("HTMLFile").parentWindow.decodeURIComponent(sURI)
End Function
Using a Custom Function
Decoding
' sLang : HTML or PHP
' ? decodeURL("https%3A%2F%2Fwww.bing.com%2Fmaps%2F%3Fv%3D2%26where1%3DMount+Rushmore+National+Memorial%2C+13000+SD+Highway+244%2C+Keystone%2C+SD%2C+United+States")
' https://www.bing.com/maps/?v=2&where1=Mount Rushmore National Memorial, 13000 SD Highway 244, Keystone, SD, United States
' ? decodeURL("https://www.bing.com/maps/?v=2&where1=Mount+Rushmore+National+Memorial%2C+13000+SD+Highway+244%2C+Keystone%2C+SD%2C+United+States")
' https://www.bing.com/maps/?v=2&where1=Mount Rushmore National Memorial, 13000 SD Highway 244, Keystone, SD, United States
Function decodeURL(ByVal sURL As String) As String
Dim aChar() As Variant 'Plain text characters
Dim aCharHex() As Variant 'Encoded Hex Value
Dim i As Long
aChar = Array(" ", " ", "!", """", "#", "$", "%", "&", "'", "(", ")", "*", "+", ",", "-", ".", "/", ":", _
";", "<", "=", ">", "?", "@", "[", "\", "]", "^", "_", "`", "{", "|", "}", "~")
aCharHex = Array("+", "%20", "%21%20", "%22", "%23", "%24", "%25", "%26", "%27", "%28", "%29", "%2A", "%2B", _
"%2C", "-", ".", "%2F", "%3A", "%3B", "%3C", "%3D", "%3E", "%3F", "%40", "%5B", "%5C", _
"%5D", "%5E", "_", "%60", "%7B", "%7C", "%7D", "%7E")
For i = 0 To UBound(aChar)
sURL = Replace(sURL, aCharHex(i), aChar(i))
Next i
decodeURL = sURL
End Function
