Excel VBAでOpanAI apiで質問して受け取る関数

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