Excelでの集計結果を要約させたり、セルに入力した質問に自動で回答させたりできたら便利だと思ったことはありませんか。実は、ExcelVBAからWinHTTPを使ってOpenAIのChatGPT API（Chat Completions API）を呼び出すことで、シート上でAIとのやり取りを自動化できます。
この記事では、VBAからChatGPT APIにリクエストを送り、回答をセルに書き込むマクロの作り方を、APIキーの準備からJSONの組み立て・レスポンスの解析まで順を追って解説します。
この記事で作るもの
セルA1に質問文を入力してマクロを実行すると、ChatGPTからの回答がセルB1に自動で書き込まれる、というシンプルな仕組みを作ります。VBAには標準のJSONパーサーがないため、リクエスト用のJSON文字列を自作し、レスポンスは正規表現で必要な部分だけを抜き出します。
事前準備：OpenAI APIキーの取得
OpenAIの管理画面（platform.openai.com）でアカウントを作成し、APIキーを発行しておきます。APIキーは「sk-」から始まる文字列で、このあと紹介するマクロの中で使用します。
APIキーはコードに直接書き込まず、セルや設定用のテキストファイルなど、共有されない場所に保存しておくことを強くおすすめします。マクロ付きブックを他人と共有する際に、APIキーがそのまま流出してしまう事故を防ぐためです。
WinHTTPでAPIリクエストを送る基本
VBAからHTTP通信を行うには、WinHttp.WinHttpRequest.5.1オブジェクトを使います。POSTメソッドでURLを指定し、ヘッダーとリクエストボディを設定して送信する、という流れです。
Dim http As Object
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
With http
.Open "POST", "https://api.openai.com/v1/chat/completions", False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Authorization", "Bearer " & apiKey
.send requestBody
End With
AuthorizationヘッダーにBearerの後ろにAPIキーを続けて指定するのがポイントです。これを忘れると認証エラー（ステータスコード401）が返ってきます。
実践：質問をセルに書いて回答を取得するマクロ
JSON文字列の組み立て、送信、レスポンス解析までを行う一連のコードです。標準モジュールに貼り付けて使用してください。
Sub AskChatGPTAndWriteToCell()
Dim apiKey As String
apiKey = "sk-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ' ご自身のAPIキーに置き換えてください
Dim question As String
question = Range("A1").Value
If question = "" Then
MsgBox "A1セルに質問を入力してください"
Exit Sub
End If
Range("B1").Value = "問い合わせ中..."
Range("B1").Value = CallChatGPT(apiKey, question)
End Sub
Function CallChatGPT(ByVal apiKey As String, ByVal prompt As String) As String
Dim http As Object
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
Dim requestBody As String
requestBody = "{""model"":""gpt-4o-mini"",""messages"":[{""role"":""user"",""content"":""" _
& EscapeJson(prompt) & """}],""temperature"":0.7}"
With http
.Open "POST", "https://api.openai.com/v1/chat/completions", False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Authorization", "Bearer " & apiKey
.send requestBody
End With
If http.Status = 200 Then
CallChatGPT = ExtractContent(http.responseText)
Else
CallChatGPT = "エラー(" & http.Status & "): " & http.responseText
End If
End Function
JSON文字列を組み立てる（エスケープ処理）
質問文の中にダブルクォートや改行が含まれていると、JSONとして不正な形になってしまいます。送信前に必ずエスケープ処理をかけておきます。
Function EscapeJson(ByVal text As String) As String
text = Replace(text, "\", "\\")
text = Replace(text, """", "\""")
text = Replace(text, vbCrLf, "\n")
text = Replace(text, vbLf, "\n")
EscapeJson = text
End Function
レスポンスから回答本文を取り出す
Chat Completions APIのレスポンスはchoices[0].message.contentというネスト構造のJSONですが、今回は本格的なJSONパーサーを使わず、正規表現で"content":"..."の部分だけを抜き出す簡易的な方法で対応します。
Function ExtractContent(ByVal jsonText As String) As String
Dim re As Object
Set re = CreateObject("VBScript.RegExp")
re.Pattern = """content""\s*:\s*""((?:[^""\\]|\\.)*)"""
re.Global = False
If re.Test(jsonText) Then
Dim m As Object
Set m = re.Execute(jsonText)(0)
ExtractContent = UnescapeJson(m.SubMatches(0))
Else
ExtractContent = "回答の取得に失敗しました: " & jsonText
End If
End Function
Function UnescapeJson(ByVal text As String) As String
text = Replace(text, "\n", vbLf)
text = Replace(text, "\""", """")
text = Replace(text, "\\", "\")
UnescapeJson = text
End Function
複数のchoicesを扱ったり、より複雑な構造のレスポンスを正確に処理したい場合は、JsonConverter.basなどのJSONパーサーライブラリを導入する方法もあります。まずは今回のような簡易的な抽出でも、単発の質問応答であれば十分に実用できます。
注意点
ChatGPT APIを業務マクロに組み込む際は、次の点に注意してください。
- APIキーの管理：コードへの直書きは避け、環境変数や別ファイルからの読み込みに切り替えるのが望ましいです
- 料金：APIはリクエストごとに従量課金されるため、大量のセルに一括で問い合わせる処理を組む場合は事前にコストを確認してください
- エラー処理：ネットワークエラーやレート制限（ステータスコード429）が発生することがあるため、
http.Statusを必ずチェックしてください - 社外秘データの送信：機密情報を含む質問文を外部APIに送信することになるため、利用ルールを事前に確認してください
まとめ
VBAからWinHttp.WinHttpRequest.5.1を使ってOpenAIのChat Completions APIを呼び出せば、Excelのセルに入力した質問に対してChatGPTの回答を自動取得できます。JSONの組み立てとレスポンスの解析さえ押さえておけば、要約・分類・文章の下書き作成など、さまざまな業務にAIを組み込むきっかけになります。
APIキーの管理と利用料金には十分注意しながら、まずは簡単な問い合わせから試してみてください。
コメント