OpenAI-vba-Chat-api-request

VBAでOpenAIのChat API（chat/completions）にリクエストを送る完全なコード例 です。

✅ 必要な前提

ExcelやAccessなど、VBAが使える環境
Microsoft XMLライブラリ（Microsoft XML, v6.0など）への参照
OpenAIのAPIキーを保持している

🧾 フルコード：ChatGPT APIに接続して応答を取得

Sub CallOpenAIChatAPI()
    Dim http As Object
    Dim url As String
    Dim apiKey As String
    Dim jsonBody As String
    Dim responseText As String
    Dim responseJson As Object
    
    ' OpenAI APIキー（"sk-..."から始まる文字列を入れてください）
    apiKey = "YOUR_API_KEY_HERE"
    
    ' APIエンドポイント
    url = "https://api.openai.com/v1/chat/completions"
    
    ' JSONのリクエストボディを作成（会話内容をここに記述）
    jsonBody = "{""model"":""gpt-3.5-turbo""," & _
               """messages"":[ " & _
               "{""role"":""user"",""content"":""こんにちは、今日の天気は？""} " & _
               "],""temperature"":0.7}"
    
    ' HTTPリクエストを作成
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "POST", url, False
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "Authorization", "Bearer " & apiKey
    
    ' JSONを送信
    http.Send jsonBody
    
    ' レスポンスを取得
    responseText = http.responseText
    
    ' JSONレスポンスを解析（Scripting.Dictionaryを使う）
    Dim jsonParser As Object
    Set jsonParser = JsonConverter.ParseJson(responseText)
    
    ' 応答メッセージの取得
    Dim reply As String
    reply = jsonParser("choices")(1)("message")("content")
    
    ' 結果を表示
    MsgBox reply
End Sub

🧰 必須ライブラリ：JSONパーサーの導入

VBAには標準でJSON解析機能がないため、以下のいずれかを使用してください。

方法①：VBA-JSON ライブラリ（推奨）

GitHub – VBA-JSON にアクセス
JsonConverter.bas をダウンロード
VBAエディタで「ファイル → ファイルのインポート」で追加

✅ 実行方法

YOUR_API_KEY_HERE をあなたのOpenAI APIキーに置き換える
JSONパーサー（JsonConverter.bas）をインポート
マクロを実行

🎁 出力例（ChatGPTからの応答）

こんにちは！申し訳ありませんが、私は天気情報にアクセスできません。

必要があれば以下のような機能も追加できます：

ユーザー入力を動的に受け取る
応答履歴を保存する
長文の応答をシートに出力する

やってみたいことがあれば教えてください。それに合わせてカスタマイズもできますよ！

実行プログラム

OpenAI にアクセスする

Sub callChatGPTResponse()
Dim http As Object, json As Object
Dim apiKey As String, url As String
Dim data As String, response As String, res As String

' API キーを設定（取得したキーを入れてください）
apiKey = "My Key"

'メッセージ
sMessage = "あなたはVBAの専門家です,You must reply in Markdown format"
sPrompt = "VBA でOpenAIのAPIを使った検索結果を取得する方法は？"

' OpenAIのエンドポイント
url = "https://api.openai.com/v1/chat/completions"

' JSON データの作成
data = "{""model"":""gpt-3.5-turbo""," & _
    """messages"":[ " & _
    "{""role"":""system"",""content"":""" & Replace(sMessage, """", "\""") & """}," & _
    "{""role"":""user"",""content"":""" & Replace(sPrompt, """", "\""") & """}" & _
    "],""temperature"":0.7}"

' HTTPリクエストを作成
Set http = CreateObject("MSXML2.XMLHTTP")
With http
    .Open "POST", url, False
    .setRequestHeader "Content-Type", "application/json"
    .setRequestHeader "Authorization", "Bearer " & apiKey
    .Send data
    response = .responseText
End With

' JSON を解析して応答を取得
Set json = JsonConverter.ParseJson(response)
res = json("choices")(1)("message")("content")

' クリーンアップ
Set http = Nothing
Set json = Nothing

    'テスト用出力
Debug.Print res

'ファイルに保存
Call saveToFile(res)

'シートに出力
Call toSheet(res)

End Sub

結果をファイルに保存する

Sub saveToFile(s As String)
    Dim filePath As String
    Dim fileNo As Integer
    
    ' ファイルパスの指定
    filePath = CurDir & "\output_write.txt"
    
    ' ファイルナンバーの取得
    fileNo = FreeFile

    ' ファイルを開く（または新しく作成）
    Open filePath For Output As #fileNo

    ' ファイルにデータを書き込む
    Write #fileNo, s

    ' ファイルを閉じる
    Close #fileNo

End Sub

結果をシートに書き込む

Sub toSheet(s As String)
Dim ws As Worksheet
Set ws = Worksheets(“sheet1”)
‘ 改行で分割
Lines = Split(s, vbCrLf)

' シートに1行ずつ書き込む（A列に）
For i = 0 To UBound(Lines)
    ws.Cells(i + 1, 1).Value = Lines(i)
Next i