VBAでREST APIリクエスト

EXCEL

VBAでREST APIリクエスト: 外部ライブラリ不使用の高度な連携

VBAによるREST APIリクエストは、外部ライブラリ不使用でHTTP通信を実現し、Officeアプリケーションのデータ連携能力を拡張する。

背景/要件

企業システムにおいて、ExcelやAccessから外部Webサービスと連携し、データ取得や更新を行う需要は高い。しかし、セキュリティポリシーにより追加のCOMコンポーネントやDLLのインストールが制限される環境では、一般的なREST APIクライアントライブラリの使用が困難である。この要件に対し、Windows OSに標準搭載されているWinHttpRequestオブジェクト（WinHttp.dll経由で提供されるCOMコンポーネント）を利用し、外部ライブラリへの依存なしにREST APIリクエストを実現する。さらに、Win32 APIを直接利用した性能測定や、Officeアプリケーション特有の性能チューニングを適用する。

設計

REST APIリクエストの処理は、WinHttpRequestオブジェクトを中心に構築する。リクエストの準備、送信、レスポンスの受信、およびその後のデータ処理が主要なフェーズとなる。JSON形式のレスポンスは、VBAの文字列操作や正規表現オブジェクト(VBScript.RegExp)を用いて解析する。

データモデル

  • リクエスト: URL (String), メソッド (String: GET, POST, PUT, DELETE), ヘッダー (Dictionary/Collection), ボディ (String)。
  • レスポンス: ステータスコード (Long), ステータステキスト (String), ヘッダー (String), ボディ (String)。

処理フロー

graph TD
    A["VBAマクロ開始"] --> B{"APIリクエスト準備"};
    B --> C["WinHttpRequestオブジェクト作成"];
    C --> D["HTTPメソッド/URL設定 (GET/POST)"];
    D --> E["ヘッダー設定 (Content-Type, Authorization)"];
    E --> F["リクエストボディ設定 (POSTの場合)"];
    F --> G["Sendリクエスト実行"];
    G --> H{"レスポンス待機"};
    H -- 成功 --> I{"HTTPステータスコード判定"};
    I -- 200 OK --> J["レスポンスボディ取得"];
    J --> K["JSONパース/データ抽出"];
    K --> L["データ整形/加工"];
    L --> M["Officeアプリへの書き込み (Excelシート/Accessテーブル)"];
    M --> N["VBAマクロ終了"];
    I -- エラー (4xx/5xx) --> O["エラーハンドリング/ログ記録"];
    O --> N;
    H -- タイムアウト/ネットワークエラー --> O;

実装

以下のコードは、ExcelおよびAccessを対象に、WinHttpRequestとWin32 API、VBA組み込み関数を組み合わせてREST APIリクエストを実行する。JSONPlaceholderという公開APIを利用してデータの取得と更新をシミュレートする。

性能計測のためのWin32 API宣言

' 標準モジュールに記述
#If VBA7 Then
    Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
    Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
#Else
    Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
#End If

Private m_freq As Currency ' 1秒間のカウント数
Private m_start As Currency ' 計測開始時のカウント

Public Sub StartTimer()
    QueryPerformanceFrequency m_freq
    QueryPerformanceCounter m_start
End Sub

Public Function StopTimer() As Double
    Dim stopTime As Currency
    QueryPerformanceCounter stopTime
    StopTimer = (stopTime - m_start) / m_freq
End Function

' VBScript.RegExpオブジェクトの参照設定なし利用
Public Function GetRegExpObject() As Object
    On Error Resume Next
    Set GetRegExpObject = CreateObject("VBScript.RegExp")
    On Error GoTo 0
End Function

Excelでの実装: GETリクエストとシートへの書き込み

JSONPlaceholderからTODOリストを取得し、Excelシートに書き込む。

' 標準モジュールに記述
Public Sub GetApiDataToExcel()
    Dim httpReq As Object
    Dim apiUrl As String
    Dim jsonResponse As String
    Dim regEx As Object ' VBScript.RegExp
    Dim matches As Object
    Dim match As Object
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim data() As Variant
    Dim i As Long
    Dim currentDataRow As Long

    ' 性能計測開始
    StartTimer

    ' Excel最適化設定
    Set ws = ThisWorkbook.Sheets("Sheet1")
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    apiUrl = "https://jsonplaceholder.typicode.com/todos"

    ' WinHttpRequestオブジェクトの作成
    Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    With httpReq
        .Open "GET", apiUrl, False ' 同期リクエスト
        .Send
        If .Status = 200 Then
            jsonResponse = .ResponseText
        Else
            MsgBox "APIエラー: " & .Status & " - " & .StatusText, vbCritical
            GoTo CleanUp
        End If
    End With

    ' JSON簡易パース (正規表現を使用)
    Set regEx = GetRegExpObject
    If regEx Is Nothing Then
        MsgBox "VBScript.RegExpオブジェクトを作成できません。", vbCritical
        GoTo CleanUp
    End If

    With regEx
        .Pattern = """id"": (\d+),\s*""title"": ""([^""]+)"",\s*""completed"": (true|false)"
        .Global = True
        Set matches = .Execute(jsonResponse)
    End With

    If matches.Count = 0 Then
        MsgBox "データが見つかりませんでした。", vbInformation
        GoTo CleanUp
    End If

    ' 配列にデータを格納
    ReDim data(1 To matches.Count, 1 To 3)
    currentDataRow = 1
    For Each match In matches
        data(currentDataRow, 1) = CLng(match.SubMatches(0)) ' id
        data(currentDataRow, 2) = match.SubMatches(1)       ' title
        data(currentDataRow, 3) = CBool(match.SubMatches(2)) ' completed
        currentDataRow = currentDataRow + 1
    Next match

    ' シートにヘッダーを書き込み
    ws.Cells.ClearContents
    ws.Range("A1").Value = "ID"
    ws.Range("B1").Value = "Title"
    ws.Range("C1").Value = "Completed"
    ws.Range("A1:C1").Font.Bold = True

    ' 配列からシートに一括書き込み
    If currentDataRow > 1 Then
        ws.Range("A2").Resize(UBound(data, 1), UBound(data, 2)).Value = data
    End If

    ws.Columns("A:C").AutoFit
    MsgBox "APIデータが正常に取得され、シートに書き込まれました。" & vbCrLf & _
           "処理時間: " & Format(StopTimer, "0.000") & "秒", vbInformation

CleanUp:
    Set httpReq = Nothing
    Set regEx = Nothing
    Set matches = Nothing
    Set ws = Nothing
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub

Accessでの実装: POSTリクエストとテーブルへの挿入

JSONPlaceholderに新しいTODOアイテムを送信し、その結果をAccessテーブルに保存する。

' 標準モジュールに記述
Public Sub PostApiDataToAccess()
    Dim httpReq As Object
    Dim apiUrl As String
    Dim requestBody As String
    Dim jsonResponse As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim query As String
    Dim userId As Long, id As Long
    Dim title As String, completed As Boolean

    ' 性能計測開始
    StartTimer

    ' テーブルが存在しない場合は作成
    Set db = CurrentDb
    On Error Resume Next
    Set tdf = db.TableDefs("ApiTodoResults")
    On Error GoTo 0

    If tdf Is Nothing Then
        Set tdf = db.CreateTableDef("ApiTodoResults")
        With tdf
            Set fld = .CreateField("UserID", dbLong)
            .Fields.Append fld
            Set fld = .CreateField("ID", dbLong)
            .Fields.Append fld
            Set fld = .CreateField("Title", dbText, 255)
            .Fields.Append fld
            Set fld = .CreateField("Completed", dbBoolean)
            .Fields.Append fld
        End With
        db.TableDefs.Append tdf
        Set tdf = Nothing
        MsgBox "テーブル 'ApiTodoResults' が作成されました。", vbInformation
    End If

    apiUrl = "https://jsonplaceholder.typicode.com/todos"
    userId = 1
    title = "Learn VBA REST API"
    completed = False
    requestBody = "{""userId"": " & userId & ", ""title"": """ & title & """, ""completed"": " & LCase(CStr(completed)) & "}"

    ' WinHttpRequestオブジェクトの作成
    Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    With httpReq
        .Open "POST", apiUrl, False ' 同期リクエスト
        .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
        .Send requestBody
        If .Status = 201 Then ' Created
            jsonResponse = .ResponseText
        Else
            MsgBox "APIエラー: " & .Status & " - " & .StatusText, vbCritical
            GoTo CleanUp
        End If
    End With

    ' JSON簡易パース (JSONPlaceholderのPOSTレスポンスは新しく作成されたオブジェクト)
    ' 例: {"userId": 1, "title": "...", "completed": false, "id": 201}
    Dim regEx As Object
    Set regEx = GetRegExpObject
    If regEx Is Nothing Then
        MsgBox "VBScript.RegExpオブジェクトを作成できません。", vbCritical
        GoTo CleanUp
    End If

    ' idの抽出
    regEx.Pattern = """id"": (\d+)"
    Set tdf = regEx.Execute(jsonResponse)
    If tdf.Count > 0 Then id = CLng(tdf(0).SubMatches(0)) Else id = 0

    ' Accessテーブルに結果を挿入 (DAO使用)
    db.BeginTrans ' トランザクション開始
    Set rs = db.OpenRecordset("ApiTodoResults", dbOpenDynaset)
    With rs
        .AddNew
        .Fields("UserID").Value = userId
        .Fields("ID").Value = id
        .Fields("Title").Value = title
        .Fields("Completed").Value = completed
        .Update
    End With
    db.CommitTrans ' トランザクションコミット

    MsgBox "APIにデータが送信され、Accessテーブルに結果が保存されました。" & vbCrLf & _
           "処理時間: " & Format(StopTimer, "0.000") & "秒", vbInformation

CleanUp:
    On Error Resume Next
    If Not rs Is Nothing Then
        If rs.EditMode = dbEditAdd Then rs.CancelUpdate ' エラーでAddnew中の場合
        rs.Close
    End If
    If db.Transactions Then db.Rollback ' エラーでトランザクションが残っている場合
    Set rs = Nothing
    Set db = Nothing
    Set httpReq = Nothing
    Set regEx = Nothing
    On Error GoTo 0
End Sub

検証

  1. GETリクエスト: GetApiDataToExcel を実行し、Sheet1にJSONPlaceholderのTODOリストが正しくID、Title、Completedの列で表示されることを確認する。HTTPステータスが200であることをVBAの実行ログやメッセージボックスで確認する。
  2. POSTリクエスト: PostApiDataToAccess を実行し、Accessの「ApiTodoResults」テーブルに新しいエントリが追加されることを確認する。HTTPステータスが201であることを確認する。
  3. エラーハンドリング: ネットワークを切断してコードを実行し、APIエラーメッセージが正しく表示されることを確認する。
  4. 性能チューニング: GetApiDataToExcel の実行時間を、Application.ScreenUpdating などを無効化した場合と有効な場合で比較する。例えば、1000件のデータ取得の場合、無効化することで約10秒から0.5秒以下に短縮されるといった差が確認できる。PostApiDataToAccessでは、トランザクションを使用しない場合と比較し、大量データ挿入時の速度向上（例: 1000件で1秒から0.1秒へ）を確認する。

運用

実行手順

  1. 上記VBAコードをExcelまたはAccessの標準モジュールにコピーする。
  2. Excelの場合は、シート名を「Sheet1」とするか、コード内のシート名を適宜変更する。
  3. マクロを有効化する（ファイル>オプション>トラストセンター>トラストセンターの設定>マクロの設定）。
  4. VBAエディタ（Alt+F11）から該当プロシージャを実行するか、ボタンなどにマクロを割り当てて実行する。

ロールバック方法

APIリクエストの実行後に問題が発生した場合、以下の手順でロールバック可能である。

  1. Excel: シートのデータは上書きされるため、実行前のデータを手動でバックアップするか、ファイルを閉じる際に変更を保存しない。
  2. Access: PostApiDataToAccess プロシージャはトランザクションを使用しているため、データ挿入中にエラーが発生した場合は自動的にロールバックされる。正常に完了したデータについては、Accessのテーブルから対象レコードを手動で削除する。
  3. VBAコード: 異常動作が確認された場合は、VBAモジュールからコードを削除するか、コメントアウトして無効化する。

認証情報の管理

APIキーや認証トークンはコードに直書きせず、以下の方法で管理する。

  • Excel: 特定のシートのセル、または非表示の名前付き範囲に格納する。
  • Access: 別のテーブルに格納し、必要な時に取得する。
  • 環境変数: Windowsの環境変数に設定し、VBAからEnviron()関数で取得する。

落とし穴

  • 複雑なJSONパース: 外部ライブラリがない場合、ネストが深いJSONや動的なキーを持つJSONのパースは正規表現だけでは非常に困難になる。簡易的なJSON構造に限定するか、自前でパースロジックを実装する必要がある。
  • 非同期リクエスト: WinHttpRequestは非同期モードもサポートするが、VBAではイベントハンドリングが煩雑なため、実務では同期リクエストが一般的である。長時間の処理にはUIフリーズを避ける工夫が必要。
  • 文字コード: WinHttpRequestはResponseTextプロパティでUTF-8などを自動的に処理するが、まれに文字化けが発生する場合がある。その際はResponseBody（バイト配列）を取得し、ADODB.Streamオブジェクトなどで明示的に変換を試みる必要がある。
  • タイムアウト: ネットワーク状況によりAPIリクエストが長時間応答しない場合があるため、WinHttpRequest.SetTimeoutsメソッドで明示的にタイムアウトを設定することが重要である。
  • セキュリティ: APIキーなどの認証情報をコード内やファイル内に保存する際は、アクセス制限や暗号化などの対策を講じる必要がある。

まとめ

VBAにおけるREST APIリクエストは、WinHttpRequestオブジェクトとVBScript.RegExp、そしてWin32 APIを組み合わせることで、外部ライブラリに依存せず実現可能である。ExcelやAccessといったOfficeアプリケーションの性能特性を理解し、ScreenUpdatingの無効化、配列への一括書き込み、データベーストランザクションといった最適化手法を適用することで、実用的な処理速度を確保できる。これにより、Office環境から外部Webサービスと連携し、業務の自動化とデータ活用の幅を広げられる。

ライセンス：本記事のテキスト/コードは特記なき限り CC BY 4.0 です。引用の際は出典URL（本ページ）を明記してください。
利用ポリシー もご参照ください。

コメント

タイトルとURLをコピーしました