EXCELにDECODEURL関数を作る

EXCELでURLの解析をしたくなった。

EXCELにはENCODEURLという関数があって、エンコードはこれで簡単に出来ることが分かったのだが、デコード用の関数は無いようだった。(何故無いんですか、MSさん。。。)

調べると、下記の様なScriptControlを使ったコードが出てきた。

'https://www.relief.jp/docs/003799.html
Public Function URL_Decode(ByVal strOrg As String) As String
　With CreateObject("ScriptControl")
　　.Language = "JScript"
　　URL_Decode = .CodeObject.decodeURI(strOrg)
　End With
End Function

大体、このコードが出てくるんだけど、「msscript.ocx」は、６４ビット版のEXCELだと使えないみたい。(使用バージョン: Microsoft Office Professional Plus 2021)

頑張って、64bitで動くmsscript.ocxを作るとか、テキスト受け渡しに絞るなら「htmlfile」でdecodeURIComponentを実行という方法もあるけど、Scripting.Dictionaryから、汎用的にJScriptのコードを実行出来そうな関数を作ってる人がいたので利用させてもらうことにした。

公開されてた、JSFuncでdecodeURIComponentを実行する形でDECODEDURLを実装。

これで、EXCELのENCODEURLで変換したコードが正しく逆変換されたので、問題なさげ。

Option Explicit
'https://qiita.com/nukie_53/items/297e524bcc8e43f9b5d1
Function JSFunc( _
        args As String, _
        funcBody As String, _
        Optional autoReturn As Boolean = True) As Object

    Const EXEC_SCRIPT = _
            "this.createFunc=" & _
                "function(args,funcBody){" & _
                    "return new Function(args,funcBody);}"
    '各種初期化
    '関数オブジェクトのキャッシュ
    Static funcCache As Object 'As Scripting.Dictionary
    If funcCache Is Nothing Then Set funcCache = VBA.CreateObject("Scripting.Dictionary")

    'JScript実行環境。参照を保持しないとインスタンスしたfunctionオブジェクトも消える
    Static htmlDoc    As Object 'As MSHTML.HTMLDocument
    Static createFunc As Object 'JScript function

    If htmlDoc Is Nothing Then
        Call funcCache.RemoveAll
        Set htmlDoc = VBA.CreateObject("htmlfile")

        'JScriptのグローバル変数に関数を定義
        Call htmlDoc.parentWindow.execScript(EXEC_SCRIPT)

        '作成した関数を静的変数に保管（書き換え防止）
        Set createFunc = htmlDoc.parentWindow.createFunc
    End If


    'キャッシュ用に整形
    Dim trimedArgs As String, trimedBody As String
    trimedArgs = VBA.Trim$(args)
    If autoReturn Then
        trimedBody = "return " & VBA.Trim$(funcBody)
    Else
        trimedBody = VBA.Trim$(funcBody)
    End If

    Dim cacheKey As String
    cacheKey = trimedArgs & "|" & trimedBody


    'キャッシュに無ければ新規インスタンス
    If Not funcCache.Exists(cacheKey) Then
        Call funcCache.Add(cacheKey, createFunc(trimedArgs, trimedBody))
    End If

    Set JSFunc = funcCache.Item(cacheKey)
End Function

'https://memo-nikki.info/?p=3946
Function DECODEDURL(s As String)
    Dim funcdec
    Set funcdec = JSFunc("s", "decodeURIComponent(s)")
    DECODEDURL = funcdec(s)
End Function

使い方は、「EXCEL ユーザー定義関数」でググっても出てきますし、下記の様な本だとchapter8にユーザー定義関数が書いてます。。

ExcelVBA［完全］入門

まあ、作った関数としては悪くないんですが、Microsoftがデフォルトで実装しておいて欲しい内容ではありますね。。。


コカ・コーラチルアウトリラクゼーションドリンク 250ml 缶 ×30本	キリン力水 300ml 24本缶 DHA 炭酸飲料炭酸リフレッシュ	強強打破 10本	【第3類医薬品】トメルミン 12錠