前回、下記の通り Excel VBA から OpenAI の Response API を使えるようにしました。
そこで今回は１歩先に進めて、Excel VBAからRAG連携するように改修しましたのでここにその内容を記録しておきます。
主に修正したのは下記の４箇所です。
修正①：RAGで使用するVector Store IDの設定
Vector Store IDについては以下の回で取得したものを設定しています。
修正②：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
実際にこれを実行したところ、以下のような結果となりました。
