🚀【レガシー Excel】VBA で Web API を呼び出す
Office スクリプト で Web API を呼び出す記事も書きました。
現代的な Excel の自動化手法にご興味のある方は、ぜひそちらもご覧ください。
▶ 【モダン Excel】Office スクリプト で Web API を呼び出す #OfficeScripts
🛠 準備
🔧 VBA-JSON のインポート
- VBA-JSON の最新版 (.zip) をダウンロードする。
- ダウンロードしたファイルを解凍する。
- 解凍したフォルダを任意の場所に配置する。
- Excel を起動し、VBA の開発ツールを開く。
- メニューから ファイル (F) > ファイルのインポート (I) を選択し、解凍したフォルダ内の「JsonConverter.bas」をインポートする。
- [ツール(T)] > [参照設定(R)] から「Microsoft Scripting Runtime」にチェックを入れる。
- ※これにより Dictionary 型が使用可能になります。
💻 VBA コード
⚙️ Web API を呼び出すメソッド
以下は、Web API を呼び出す共通メソッドのサンプルです。
GET や POST など、リクエストの種類に応じたパラメータを JSON 化して送信し、レスポンスを ParseJson
で返します。
Public Function KickWebApiOfJson(ByVal request As String, ByVal url As String, Optional ByVal param As Object) As Object
Dim json
json = ConvertToJson(param)
Dim http As Object
Set http = CreateObject("MSXML2.XMLHTTP")
With http
.Open request, url, False
.SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
.send json
If .ResponseText <> "" Then
Set KickWebApiOfJson = ParseJson(.ResponseText)
End If
End With
End Function
📤 メソッドの呼び出し方
以下、GET および POST の呼び出し例をご紹介します。
✅ GET サンプル
全件取得(一覧表示)のサンプル
Sub OnClick_GetAllButton()
Dim res As Collection
Set res = KickWebApiOfJson("GET", "https://jsonplaceholder.typicode.com/todos")
' ヘッダー出力(取得する項目:userId、id、title、completed)
Cells(1, 1) = "userId"
Cells(1, 2) = "id"
Cells(1, 3) = "title"
Cells(1, 4) = "completed"
Dim i As Integer
i = 2
Dim item As Variant
For Each item In res
Cells(i, 1) = item("userId")
Cells(i, 2) = item("id")
Cells(i, 3) = item("title")
Cells(i, 4) = item("completed")
i = i + 1
Next item
End Sub
ID 指定で取得(1件取得)のサンプル
Sub OnClick_GetButton()
Dim id As Integer
id = Range("C2").Value ' 例として、セル C2 に対象の ID を入力する
Dim res As Dictionary
Set res = KickWebApiOfJson("GET", "https://jsonplaceholder.typicode.com/todos/" & id)
Range("C3").Value = res("id")
Range("C4").Value = res("title")
Range("C5").Value = res("completed")
End Sub
✉️ POST サンプル
以下は、Excel の入力セル(A1~A3)の値を利用して、
https://httpbin.org/post
に対して POST リクエストを実行するサンプルです。
Sub OnClick_PostButton()
Dim param As New Dictionary
param("id") = Range("C3").Value
param("value") = Range("C4").Value
param("comment") = Range("C5").Value
Dim res As Dictionary
Set res = KickWebApiOfJson("POST", "https://httpbin.org/post", param)
' httpbin.org は送信した JSON を、レスポンス内の "json" プロパティに返す
Range("E1").Value = "POST リクエストが成功しました"
' レスポンスの "json" 部分を E2 セルに出力
Range("E2").Value = ConvertToJson(res("json"))
End Sub