excelvbacharacter-encodingurldecode

Excel VBA decode url for specific charset (i.e. euc-kr)


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

Solution

  • 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