VBA

【VBA】ScriptControlを使用せずにJSONをパースする

ExcelでJSONを扱いたいときなんですが、基本的には「データの取得と変換」で取り込むのが一番簡単だと思います。（これは記事の最後の方で記載します）

しかし、「VBAでRESTAPIに対してリクエストを投げて色々解析して処理を分岐させたい」とかなってくるとコード内でJSONをパースしたくなります。

その方法などについて記載をしてみたいと思います。

ScriptControlは64bit環境で動かない

Webで「VBA JSON パース」と検索すると、ほとんどのページでScriptControlを使用したロジックが紹介されます。

以下のような感じですね。

Private Sub test()
  Dim js As Object
  Dim jsonObj As Object
  Set js = CreateObject("ScriptControl")
  js.Language = "JScript"
  js.AddCode "function Parse(str) { return eval('(' + str + ')'); };"
  Set jsonObj = js.CodeObject.Parse("{""name"":""value""}")
End Sub

しかし自分の環境で上記コードを試すと以下のエラーになってしまいます。

実行時エラークラスが登録されていません

実行時エラー’-2147221164(80040154)’

クラスが登録されていません

これはScriptControl(MSScript.ocx)が64bit環境に存在していないためです。

代替として一番ラクなのはMITライセンスで公開されている64bit対応版のMSScript.ocxを使用することです。

https://tablacus.github.io/scriptcontrol.html

上記のページに有るダウンロードからファイルをダウンロードして、インストールするとScriptControlが使用できるようになります。

↓冒頭に書いたコードの実行結果

ScriptControl64ビットサンプル

ちょっと見にくいですが、jsonObjという変数にパラメータがパースされて格納されていることがわかります。

しかし、この方法はすべての端末に64bit対応版のMSScript.ocxをインストールする必要があるので、ExcelVBAをクライアントに配布する場合には使用しにくいです。

VBA-JSONを使ってJSONをパースする

自作でVBAをパースする関数を作るのはかなり面倒です。（配列なども考慮しないといけないため）

そこで、他の方が作ったAPIを使用してサクッと実装するのが良いかと思います。他のサイトなどで情報を集めたところ、以下が使いやすくてよいかと思いました。

https://github.com/VBA-tools/VBA-JSON

導入方法

まず上記のGitからMasterをクローンします。Gitとか入れてねーよって人はダウンロードでもOKです。

Gitからダウンロードを行う

すると、specsフォルダ内に「VBA-JSON – Specs.xlsm」というファイルがあるのでこちらを開きます。

VBEから以下の2ファイルをエクスポートします。

  • JsonConverter
  • Dictionary
JsonConverterとDictionaryをエクスポート

その他のファイルは必要なのか不明…。今のところ無くても問題なく動いているので放置しています。

エクスポートしたファイルを自分のEXCELにインポートすれば準備完了です。

使い方

Sub test()
    Dim Json As Object
    Set Json = ParseJson("{""a"":123,""b"":[1,2,3,4],""c"":{""d"":456}}")
    Debug.Print Json("a")
    Debug.Print Json("b")(1)
End Sub

JsonConverter.basの中にあるParseJsonという関数でJsonを連想配列に変換することが出来ます。

連想配列で戻ってくるため、非配列項目はそのまま項目名を引数に渡してあげれば値を取得することが出来ます。上記コードのJson(“a”)の部分です。

配列項目は、配列として取得できるのでインデックスを指定すれば値を取得できます。上記コードのJson(“b”)(1)の部分です。

ちなみに存在しないパラメータを指定すると空文字が返ってくるようです。エラーにならないのは便利ですが、パラメータがあるけど空の場合と区別出来ないのは厄介な場合もありそうですね。

実行結果

VBA-JSONサンプル

「データの取得と変換」でJSONを取り込む

もっと簡単にやりたい時用に、冒頭で書いた以下の件について方法を記載しておきます。

基本的には「データの取得と変換」で取り込むのが一番簡単だと思います。（これは記事の最後の方で記載します）

例として、郵便番号検索のAPI（https://zipcloud.ibsnet.co.jp/api/search?zipcode=7830060）から住所などの情報を取得してみたいと思います。

まずExcelのリボンから「データ→Webから」を選択します。

Excelのリボンから「データ→Webから」

WebからのフォームでOKを押します。

WebからでOKを押す

データの変換を押します

データの変換

変換タブから「解析→JSON」を選択します。

変換タブから解析→Jsonを選択する

するとこんな感じで展開してくれます。

Json展開結果

ちなみにマクロで実行することも可能ですが、その度に接続情報が作られてしまうので、ちょっと工夫が必要な気がします。

自動保存すると以下のようなコードです。

Sub Macro2()
'
' Macro2 Macro
'

'
    ActiveWorkbook.Queries.Add Name:="search?zipcode=7830060", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    ソース = Csv.Document(Web.Contents(""https://zipcloud.ibsnet.co.jp/api/search?zipcode=7830060""),[Delimiter="":"", Columns=2, Encoding=65001, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    変更された型 = Table.TransformColumnTypes(ソース,{{""Column1"", type text}, {""Column2"", type text}})," & Chr(13) & "" & Chr(10) & "    #""解析された JSON"" = Table.TransformColumns(変更された型,{{""Column1"", Json.Document}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "" & _
        "    #""解析された JSON"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""search?zipcode=7830060"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [search?zipcode=7830060]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "search_zipcode_7830060"
        .Refresh BackgroundQuery:=False
    End With
    Range("K10").Select
    ActiveWorkbook.Queries.Add Name:="search?zipcode=7830060 (2)", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    ソース = Csv.Document(Web.Contents(""https://zipcloud.ibsnet.co.jp/api/search?zipcode=7830060""),[Delimiter="":"", Columns=2, Encoding=65001, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    変更された型 = Table.TransformColumnTypes(ソース,{{""Column1"", type text}, {""Column2"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    変更された型"
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""search?zipcode=7830060 (2)"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [search?zipcode=7830060 (2)]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "search_zipcode_7830060__2"
        .Refresh BackgroundQuery:=False
    End With
    Range("K10").Select
End Sub

この方法は、お手軽にJSONの中身を見れて便利なのですが、配列の情報などが失われてしまうため、詳細な解析をしたい場合には向きません。

難しい処理を行う場合には使えないので、結局APIと連携したいなどと言った場合はVBA-JSONにお世話になるのが良いかなと思います。


4 件のコメント

    • コメントを残す

    メールアドレスが公開されることはありません。

    日本語が含まれない投稿は無視されますのでご注意ください。（スパム対策）

    ABOUTこの記事をかいた人

    VBAによるEXCELアプリケーション開発の業務経験を生かし、日々の業務でもVBAを使用して生産性の向上を図っています。

    NEW POST最新の記事

    RECOMMENDこちらの記事も人気です。