自分はもう10年以上使っているのですが意外と知られていない技術として、Excel VBAではHTTPアクセスを用いてWebサイトの情報取得やWeb APIの実行ができます。もしかしたらニーズがあるかもしれない技術なので紹介します。
APIの例として J-Quants API を利用しますが他のAPIでも同様に使えると思います。J-Quants APIを選定したのは利用手順の中でPOSTやGETやヘッダーの設定等いろいろ技術が必要で網羅的な紹介ができるからです。
このブログでは普段は暗黙のうちにOSがMacであることを前提としていますが、この記事に限ってはWindows前提です。MacのExcelでは動作しないと思います。
APIの利用方法自体はPython版の記事があるのでこちらをご参照ください。照らし合わせながら見ると、Excel VBA の XMLHTTP60 オブジェクトの使い方が分かってくると思います。
参照設定
以下の二つを参照設定しておいてください。XMLのほうがhttpアクセスに必要です。正規表現のほうは返ってきたJSONから必要な部分を取得するのに使います。VBAはJSONの扱いが不便なので、何か事情が無ければPython等の他の言語をお勧めします。
- Microsoft XML, v6.0
- Microsoft VBScript Regular Expressions 5.5
リフレッシュトークンの取得関数
リフレッシュトークンを取得する関数のコードは以下のようになります。
Public Function get_refresh_token(email As String, passoword As String) As String
Dim objXMLHTTP As New XMLHTTP60
Dim re As New RegExp
Dim mc As MatchCollection
Dim account_data As String
Dim auth_user_url As String
account_data = "{""mailaddress"": """ & email & """,""password"": """ & passoword & """}"
auth_user_url = "https://api.jquants.com/v1/token/auth_user"
Call objXMLHTTP.Open("POST", auth_user_url, False)
Call objXMLHTTP.send(account_data)
Do While objXMLHTTP.readyState <> 4
DoEvents
Loop
' Rehresh Tokenを取り出す正規表現
re.Pattern = "refreshToken"": ""([^""]+)"""
Set mc = re.Execute(objXMLHTTP.responseText)
get_refresh_token = mc.Item(0).SubMatches(0)
End Function12行目から15行目までが、APIにデータをPOSTして結果を待っている部分です。メソッド(POST)、URLをopenで指定して、sendするときにPOSTするデータを渡しています。この構文を覚えておくと大抵のAPIは使えます。GETメソッドの時はPOSTするデータはないのでsendの引数は空でよいです。
戻ってくるデータはJSONの文字列なので、正規表現で取り出してます。
idトークンの取得関数
リフレッシュトークンが取得出来たら次はidトークンです。これはリフレッシュトークンを組クエリパラメーターでPOSTします。
Public Function get_id_token(refresh_token As String) As String
Dim objXMLHTTP As New XMLHTTP60
Dim re As New RegExp
Dim mc As MatchCollection
Dim auth_refresh_url As String
auth_refresh_url = "https://api.jquants.com/v1/token/auth_refresh?refreshtoken=" & refresh_token
Call objXMLHTTP.Open("POST", auth_refresh_url, False)
Call objXMLHTTP.send
Do While objXMLHTTP.readyState <> 4
DoEvents
Loop
' id Tokenを取り出す正規表現
re.Pattern = "idToken"": ""([^""]+)"""
Set mc = re.Execute(objXMLHTTP.responseText)
get_id_token = mc.Item(0).SubMatches(0)
ほとんど同じですね。
メインのAPIを実行する関数
idトークンが取得出来たら目当てのAPIを取得する関数を実行します。とりあえず時系列データを取ってみましょうか。
JSONで各日の４本値データが返ってくるので、1日分ずつ取得して Sheet1 のセルに張り付ける処理にしました。この時点では、まだ1日分のデータがJSON形式になっているので、Excel や VBAで利用するにはもう一段階パースする必要がありますが、ここまでできればあとは手間だけの問題でしょう。
先ほどまでのTokenの取得と違って、リクエストのヘッダーを設定しないといけないのでその処理が入っています。
Public Sub get_price(id_token As String, code As String)
Dim objXMLHTTP As New XMLHTTP60
Dim re As New RegExp
Dim mc As MatchCollection
Dim daily_quotes_url As String
Dim i As Integer
' daily_quotes_urlを構築
daily_quotes_url = "https://api.jquants.com/v1/prices/daily_quotes?code=" & code
Dim from_ As String
Dim to_ As String
Dim headers As Object
Dim daily_quotes_result As Object
Dim daily_quotes_df As Object
Call objXMLHTTP.Open("GET", daily_quotes_url, False)
Call objXMLHTTP.setRequestHeader("Authorization", "Bearer " & id_token)
Call objXMLHTTP.send
Do While objXMLHTTP.readyState <> 4
DoEvents
Loop
' 1日分のデータにマッチする正規表現
re.Pattern = "{[^{}]*Date[^{}]*}"
re.Global = True
Set mc = re.Execute(objXMLHTTP.responseText)
' セルに出力
For i = 0 To mc.Count - 1
Sheet1.Cells(i + 1, 1) = mc.Item(i)
Next i
End Sub各関数と処理を実行する
一通り関数を作りましたので、次のプロシージャを使って呼び出しましょう。
Sub main()
Dim refresh_token As String
Dim id_token As String
refresh_token = get_refresh_token("{メールアドレス}", "{パスワード}")
id_token = get_id_token(refresh_token)
Call get_price(id_token, "{証券コード}")
End Subこれで動作するはずです。
Pythonを覚えて以来、この種の処理はほとんど全部Pythonでやるようになりましたが、まだまだデータ加工でExcelの出番が発生することはあり、Excel VBA でデータ取得から一貫して行えると便利な場面もあると思います。
とはいえ、通常はVBAはJSONの扱いが不便すぎるので、Pythonでデータ取得スクリプト書いた方が早かったりもするのですがPythonが使えない環境では重宝するでしょう。