Excel VBAから呼び出すOpenAIの APIをChat CompletionsからResponse APIに書き換えた話

前回、ExcelのVBAからOpenAIのChat Completions Responses APIを利用することで、質問に対するテキスト生成を行なってみました。

Excel のVBA（マクロ）から OpenAI の API を使ってみた

しかし、Response APIというものを使えば、単純なテキスト生成だけではなく、
・Web検索
・ファイル検索
・Function Calling
・Computer Use
・MCP
・複数ステップの処理
など、AIにツールを使わせる方向へ発展させやすいという話を聞いたのでそちらに書き換えてみることにしました。

１．主な変更点

Chat Completions APIとResponse APIはいろいろと違いがあるようですが、特に大きな違いは OpenAIからのレスポンスです。

Chat Completions APIでのレスポンスは、

"output_text": "回答"

のような単純なものでした。

一方で、Response APIのレスポンスの構造は以下のようになっており、その中の output 配列にメッセージやテキスト出力が入るようです。

response
 ├─ id
 ├─ object
 ├─ status
 └─ output
      └─ message
           └─ content
                └─ output_text
                     └─ text

２．Response APIへ書き換え

以下、書き換えた結果を記載しておきます。

Option Explicit

'★Response APIを利用する為にURLを変更
'Const API_URL As String = "https://api.openai.com/v1/chat/completions"
Const API_URL As String = "https://api.openai.com/v1/responses"

Sub ApplyAddressCorrection()
    Dim apiKey As String
    Dim text As String
    Dim response As String
    Dim responseArray() As String
    Dim ws As Worksheet
    Dim i As Long
    
    Set ws = ActiveSheet
    ws.Range("B5").CurrentRegion.ClearContents
    
    apiKey = Environ("OPENAI_API_KEY")

    If apiKey = "" Then
        MsgBox "OpenAI APIキーが設定されていません。", vbCritical
        Exit Sub
    End If
    

    text = ws.Range("B2").Value & ws.Range("B3").Value

　　'★max_completion_tokensをmax_output_tokens変更
　　'★messagesをinputに変更
    'text = "{""model"": ""gpt-5-nano"", ""max_completion_tokens"": 2000" & ", ""messages"": [{""role"": ""user"", ""content"": """ & text & """}]}"
    text = _
        "{""model"":""gpt-5-nano""," & _
        """max_output_tokens"":2000," & _
        """input"":""" & text & """}"
    response = sendAPIRequest(API_URL, text, apiKey)
    
    Debug.Print response
    
　　'★レスポンスの受け取り方（関数）を変更→①
   'response = extractContent(response)
    response = ExtractResponseText(response)
    
    ws.Range("B5").Value = response

    response = Replace(response, "\n", vbLf)
    If ws.Range("D5").Value = "する" Then response = Replace(response, "。", "。" & vbLf)
    responseArray = Split(response, vbLf)
    For i = 0 To UBound(responseArray)
        ws.Range("B" & 5 + i).Value = responseArray(i)
    Next i
End Sub

Function sendAPIRequest(url As String, text As String, apiKey As String) As String
    Dim request As Object
    Set request = CreateObject("MSXML2.XMLHTTP")
    request.Open "POST", url, False
    request.setRequestHeader "Content-Type", "application/json"
    request.setRequestHeader "Authorization", "Bearer " & apiKey
    request.send text
    sendAPIRequest = request.responseText
End Function

'①レスポンスを受け取る関数
Function ExtractResponseText(response As String) As String
    Dim startPos As Integer
    Dim endPos As Integer
    Dim searchText As String

    '"text"を検索
    searchText = """type"": ""output_text"""
　　' InStr(開始位置, 検索対象, 検索文字列)
    startPos = InStr(1, response, searchText)

    If startPos = 0 Then
        'extractContent = response
        ExtractResponseText = response
        Exit Function
    End If

    'output_textの後ろから"text"を検索
    startPos = InStr(startPos, response, """text"": """)
    If startPos = 0 Then
        ExtractResponseText = response
        Exit Function
    End If

        '"""text"": """ の文字数分だけ進める
        startPos = startPos + Len("""text"": """)
        '次のダブルクォーテーションを探す
        endPos = InStr(startPos, response, """")

    If endPos = 0 Then
        'extractContent = response
        ExtractResponseText = response
        Exit Function
    End If

    'Mid(文字列, 開始位置, 文字数)
    ExtractResponseText = Mid(response, startPos, endPos - startPos)


End Function