Microsoft XML, v6.0 (MSXML6) ライブラリを利用して HTTP リクエストを実行します
JsonConverter ライブラリをVBAにインポートする必要があります。このライブラリは、GitHubから「VBA-JSON」としてダウンロードできます。
Function GetOpenAIResponse(prompt As String) As String
Dim json As Object
Dim httpRequest As Object
Set httpRequest = CreateObject("MSXML2.XMLHTTP")
Dim url As String
url = "https://api.openai.com/v1/chat/completions"
Dim apiKey As String
apiKey = "set api key" ' API キーを設定してください
' Prompt内のダブルクォートと改行をエスケープ
Dim safePrompt As String
safePrompt = Replace(prompt, """", """""") ' ダブルクォートのエスケープ
safePrompt = Replace(safePrompt, Chr(10), "\n") ' 改行のエスケープ
safePrompt = Replace(safePrompt, Chr(13), "") ' キャリッジリターンの削除
' JSON Bodyの作成
Dim jsonBody As String
' jsonBody = "{""model"":""gpt-3.5-turbo-0125"",""messages"":[{""role"":""system"",""content"":""You are a friendly assistant designed to output a string of answers.""},{""role"":""user"",""content"":""" & safePrompt & """}]}"
jsonBody = "{""model"":""gpt-4-turbo"",""messages"":[{""role"":""system"",""content"":""You are a friendly assistant designed to output a string of answers.""},{""role"":""user"",""content"":""" & safePrompt & """}]}"
With httpRequest
.Open "POST", url, False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Authorization", "Bearer " & apiKey
.send jsonBody
' ステータスコードの確認
If .Status = 200 Then
' JSONレスポンスのパース
Set json = JsonConverter.ParseJson(.responseText)
' レスポンスから回答を取り出す
Dim answer As String
answer = json("choices")(1)("message")("content") ' 配列のインデックスやキーはレスポンスの構造に依存します
'MsgBox "Response: " & answer
GetOpenAIResponse = answer
Else
Set json = JsonConverter.ParseJson(.responseText)
Dim error_message
error_message = json("error")("message")
GetOpenAIResponse = "Error: " & .Status & " " & .statusText & "mess=" & error_message
End If
End With
End Function