Help us understand the problem. What is going on with this article?

Excel から REST API を叩く

概要

REST な API を Excel から呼び出し、戻り値の JSON データをパースします。
Excel 2003 以降に対応しています。

ポイント

REST API を呼び出す方法

Excel 2013 から新たに WEBSERVICE 関数が標準関数として登場しました。
引数に URL を指定するだけで、XML や JSON といった形式問わず、結果文字列がセルに値として出力されます。

=WEBSERVICE(URL)

Excel 2010 以前のバージョンについては、MSXML2.XMLHTTP オブジェクトを利用したユーザ定義関数を定義します。
(ユーザ定義関数は、EXCEL マクロで VBA の Function として実装します)

 Function RESTAPI(URL As String)
    Dim objXMLHttp As Object, zipArr
    Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")
        objXMLHttp.Open "GET", URL, False
        objXMLHttp.Send

    RESTAPI = objXMLHttp.responseText
 End Function

JSON 形式データのパース

WEBSERVICE 関数と同様に、Excel 2013 から FILTERXML 関数が登場しました。
XML 形式の文字列解析は、本関数で賄うことができます。

しかし、JSON の解析に適した関数は残念ながら存在しません。
また、VBA ネイティブで JSON を解析する関数は存在しません。

ではどうするか。
VBA から JScript エンジンを通じて、JScript の JSON パーサーを利用します。
以下のコードを標準モジュールに突っ込んで、最後の parseJSON をユーザ定義関数として呼び出すことで
メンバーの値を取得することができます。
(parseJSON 関数は、今回呼び出す API の戻り値の構造に特化した実装になっています。)

Option Explicit

Private ScriptEngine As ScriptControl

Public Sub InitScriptEngine()
    Set ScriptEngine = New ScriptControl
    ScriptEngine.Language = "JScript"
    ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
    ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "
End Sub

Public Function DecodeJsonString(ByVal JSonString As String)
    Set DecodeJsonString = ScriptEngine.Eval("(" + JSonString + ")")
End Function

Public Function GetProperty(ByVal JsonObject As Object, ByVal propertyName As String) 'As Variant
    GetProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function

Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal propertyName As String) 'As Object
    Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName)
End Function

Public Function GetKeys(ByVal JsonObject As Object) As String()
    Dim Length As Integer
    Dim KeysArray() As String
    Dim KeysObject As Object
    Dim Index As Integer
    Dim Key As Variant

    Set KeysObject = ScriptEngine.Run("getKeys", JsonObject)
    Length = GetProperty(KeysObject, "length")
    ReDim KeysArray(Length - 1)
    Index = 0
    For Each Key In KeysObject
        KeysArray(Index) = Key
        Index = Index + 1
    Next121
    GetKeys = KeysArray
End Function

Function parseJson(strJSON As String, Index As Integer, Key As String)

    Dim objJson
    Dim i, j

    InitScriptEngine

    Set objJson = DecodeJsonString(strJSON)

    i = 0
    For Each j In objJson
      If i = Index Then
        parseJson = GetProperty(j, Key)
      End If
      i = i + 1
    Next j

End Function

2020/5/29 追記 -- 64bit 環境ではどうするの?

@nukie_53 さんからコメントでご指摘いただいたとおり、Excel 64bit 版からでは
上述の JScript を用いたコードが動きません。

いろいろ試した結果、以下のライブラリを利用することとしました。

VBA モジュールとして、JsonConverter という名前でインポートしJSON 文字列を食わせます。

  Dim JSON As Object
  Set JSON = JsonConverter.ParseJson(RESTAPI())

  For i = 1 To JSON.Count
    Debug.Print (JSON(i)("担当者氏名"))
    Debug.Print (JSON(i)("拠点名称"))
  Next

背景

建設業のひとり情シスやってます。社内システムの保持するデータを各部門で有効活用できるよう
REST サーバを立てて公開する情報をコントロールすることにしました。
サーバサイドは node(Express4) + tedious(SQLServer) です。

kintone や FileMaker のような Web データベースを導入したいのですが
Excel 大好き & 帳票文化が根付いている会社ということで、クライアントとしての Excel マクロもあわせて整備。

エンドユーザ側では自分たちの好きなように UI の設計ができるし
情シス視点では流通する情報をコントロールできて、かつ手離れもよい、ということで Win-Win。
結構好評です。

daktu32
建設業で情シスやってます。座右の銘は「発注者がしっかりせんと誰も幸せにならへんで」 ICT に関することは全部俺の仕事。IT 投資計画を考えつつ、打合せをファシリテートしつつ、社内 CSIRT で火消しをしつつ。たまに動画の編集とか、パワポのテンプレート作成とかも回ってきます。なにさせるん。
Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away