Excel VBA 解码 url 特定字符集（即 euc-kr）

Question

在 Excel VBA 中有没有办法通过指定字符集来解码 url？我对我的计算机没有管理员权限，这意味着我无法安装外部包，所以我需要一个独立的解决方案 Excel VBA （或本机环境）。

我找到了一个link here来解码一个url（下面的代码供参考）；但是，它不适用于解码为韩文字符。我收到以下错误：运行-time error '-2147352319 (80020101)' 对象 'JScriptTypeInfo' 的方法 'decode' 失败。

我一直未能找到 Excel VBA 的解决方案。（我是运行Windows10；微软Excel365，版本2107；新增韩语语言包；区域设置-- 非 unicode 程序的语言：韩语（韩国）。

这是正确结果的示例（decoded/encoded 正确使用字符集 'Korean (euc-kr)' here）：

编码：%28%C1%D6%29%B7%B9%B0%ED%C4%DA%B8%AE%BE%C6
使用 'euc-kr' 解码：(주)레고코리한

代码参考如下：

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

Answer 1

设法拼凑起来：

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

输出：

Excel VBA 解码 url 特定字符集（即 euc-kr）

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

excel

vba

character-encoding

urldecode