0

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):

  • Encoded: %28%C1%D6%29%B7%B9%B0%ED%C4%DA%B8%AE%BE%C6
  • Decoded using 'euc-kr': (주)레고코리아

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
Matt
  • 3
  • 2

1 Answers1

0

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:

enter image description here

Tim Williams
  • 154,628
  • 8
  • 97
  • 125