Is there a way in Excel VBA to decode a url by specifying the charset? I don't have admin rights to my computer, meaning I can't install external packages, so I need a self-contained solution to Excel VBA (or the native environment).
I found a link here to decode a url (code below for reference); however, it does not work for decoding to Korean characters. I receive the following error: Run-time error '-2147352319 (80020101)' Method 'decode' of object 'JScriptTypeInfo' failed.
I have been unsuccessful at trying to find solutions for Excel VBA. (I'm running Windows 10; Microsoft Excel 365, version 2107; Korean language pack added; Region setting -- language for non-unicode programs: Korean (Korea)).
Here is an example of the correct results (decoded/encoded correctly using charset 'Korean (euc-kr)' here):
Code reference below:
Sub Testing()
Debug.Print UriDecode("%28%C1%D6%29%B7%B9%B0%ED%C4%DA%B8%AE%BE%C6")
End Sub
Function UriDecode(strText As String)
Static objHtmlFile As Object
If objHtmlfile Is Nothing Then
Set objHtmlfile = CreateObject("htmlfile")
objHtmlfile.parentWindow.execScript "function decode(s) {return decodeURIComponent(s)}", "jscript"
End If
UriDecode = objHtmlfile.parentWindow.decode(strText)
End Function
Managed to cobble this together:
Sub Testing()
ActiveSheet.Range("A1").Value = _
ToKr("http://google.com?q=%28%C1%D6%29%B7%B9%B0%ED%C4%DA%B8%AE%BE%C6")
End Sub
Function ToKr(str As String) As String
With CreateObject("ADODB.Stream")
.Type = 1 'adTypeBinary
.Open
.write URLToBytes(str)
.Position = 0
.Type = 2 'adTypeText
.Charset = "euc-kr"
ToKr = .readtext() 'default is read all
End With
End Function
Public Function URLToByteArray(EncodedURL As String) As Byte()
Dim i As Long, sTmp As String
Dim col As New Collection, arrbyte() As Byte
i = 1
Do While i <= Len(EncodedURL) 'fill the collection
sTmp = Mid(EncodedURL, i, 1)
sTmp = Replace(sTmp, "+", " ")
If sTmp = "%" And Len(EncodedURL) + 1 > i + 2 Then '%-encoded?
sTmp = Mid(EncodedURL, i + 1, 2)
col.Add CByte("&H" & sTmp)
i = i + 3 'spent 3 characters...
Else
col.Add CByte(Asc(sTmp))
i = i + 1
End If
Loop
ReDim arrbyte(col.Count - 1) 'fill the byte array from the collection
For i = 1 To col.Count
arrbyte(i - 1) = col(i)
Next i
URLToByteArray = arrbyte
End Function
Output: