参考Github项目
Integrate-ChatGPT-in-Excel-using-VBA/Demo_ChatGPT.xlsm at master · Sven-Bo/Integrate-ChatGPT-in-Excel-using-VBA (github.com)
代码在ChatGPT-4o模型帮助下完成
目的：
- 简化原项目代码，定义函数，将响应输出到Excel单元格。
- 实现异步请求，Excel等待 HTTP 请求响应时不会冻结窗口。
- 配合ONEAPI使用，可在国内网络环境调用Azure Openai等大模型API接口。
Option Explicit
'=====================================================
Const API_KEY As String = "<API_KEY>"
Const API_ENDPOINT As String = "https://api.openai.com/v1/chat/completions"
Const MODEL As String = "chatgpt-3.5-turbo"
Const MAX_TOKENS As String = "512"
Const TEMPERATURE As String = "0.1"
'=====================================================
Function Chat(prompt As String) As String
' 检查 API 密钥是否可用
If API_KEY = "<API_KEY>" Then
MsgBox "请在代码中输入有效的 API 密钥。", vbCritical, "未找到 API 密钥"
Exit Function
End If
' 创建 XMLHTTP 对象
Dim httpRequest As Object
Set httpRequest = CreateObject("MSXML2.XMLHTTP")
' 定义请求体
Dim requestBody As String
requestBody = "{" & _
"""model"": """ & MODEL & """," & _
"""messages"": [{""role"": ""user"", ""content"": """ & prompt & """}]," & _
"""max_tokens"": " & MAX_TOKENS & "," & _
"""temperature"": " & TEMPERATURE & _
"}"
' 发送 HTTP 请求
With httpRequest
.Open "POST", API_ENDPOINT, True ' 使用异步请求
.SetRequestHeader "Content-Type", "application/json"
.SetRequestHeader "Authorization", "Bearer " & API_KEY
.send (requestBody)
End With
' 等待请求完成
Do While httpRequest.readyState <> 4
DoEvents
Loop
' 检查请求是否成功
If httpRequest.Status = 200 Then
Dim response As String
response = httpRequest.responseText
Dim completion As String
completion = ParseResponse(response)
' 返回生成的文本完成结果
Chat = completion
Else
MsgBox "请求失败,状态码:" & httpRequest.Status & vbCrLf & vbCrLf & "错误消息:" & vbCrLf & httpRequest.responseText, vbCritical, "OpenAI 请求失败"
Chat = ""
End If
End Function
Function ParseResponse(ByVal response As String) As String
' 从 JSON 响应中解析生成的文本
On Error Resume Next
Dim startIndex As Long
startIndex = InStr(response, """content"":""") + 11
Dim endIndex As Long
endIndex = InStr(startIndex, response, """") - 1
ParseResponse = Mid(response, startIndex, endIndex - startIndex)
On Error GoTo 0
End Function
