OpenAI の APIからRAGをつかえるようにExcel VBA を修正した話 - k2-ornata（個人的「やってみたこと」ブログ）

前回、下記の通り Excel VBA から OpenAI の Response API を使えるようにしました。

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

そこで今回は１歩先に進めて、Excel VBAからRAG連携するように改修しましたのでここにその内容を記録しておきます。

主に修正したのは下記の４箇所です。

修正①：RAGで使用するVector Store IDの設定

Vector Store IDについては以下の回で取得したものを設定しています。

OpenAIのAPIをつかってRAGを行う為に検索対象のファイルを準備してみた

修正②：max_output_tokensの変更

Response APIにてRAGを使うようになりOpenAIからのレスポンスが大きくなってきたので値を2000から10000に大きくしています。

修正③：OpenAIへのリクエストに tools を追加

OpenAIへのリクエストの中に以下のJSONを追加し、file_search を行うようにしています。

  "tools": [
    {
      "type": "file_search",
      "vector_store_ids": [
        "vs_xxxxxxxxx"
      ]
    }
  ]

修正④：JsonConverterを使う形に変更

Response APIにてRAGを使うようになりOpenAIからのJSONが複雑、かつUnicodeエスケープ化されて返ってくるようになったので、JsonConverterを利用するように変更しています。

上記３つを修正した結果は以下の通りです。

Option Explicit

Const API_URL As String = "https://api.openai.com/v1/responses"

'★①RAGで使用するVector Store ID
Const VECTOR_STORE_ID As String = "vs_xxxxxxxxxx"

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_output_tokensを2000から10000に変更
'★③OpenAIへのリクエストに tools を追加
    text = _
        "{""model"":""gpt-5-nano""," & _
        """max_output_tokens"":10000," & _
        """input"":""" & text & """," & _
        """tools"":[{" & _
        """type"":""file_search""," & _
        """vector_store_ids"":[""" & VECTOR_STORE_ID & """]" & _
    "}]}"
        
    response = sendAPIRequest(API_URL, text, apiKey)
    
    Debug.Print 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

'★④JsonConverterを使う形に変更
Function ExtractResponseText(response As String) As String

    Dim json As Object
    Dim outputItem As Variant
    Dim contentItem As Variant

    On Error GoTo ErrorHandler

    'JSON文字列を解析
    Set json = JsonConverter.ParseJson(response)

    'output配列を順番に確認
    For Each outputItem In json("output")

        'messageタイプを探す
        If outputItem("type") = "message" Then

            'content配列を確認
            For Each contentItem In outputItem("content")

                'output_textを探す
                If contentItem("type") = "output_text" Then

                    'textを取得
                    ExtractResponseText = contentItem("text")
                    Exit Function

                End If

            Next contentItem

        End If

    Next outputItem

    'output_textが見つからなかった場合
    ExtractResponseText = response
    Exit Function

ErrorHandler:

    ExtractResponseText = response

End Function