硅基流动邀请码:1zNe93Cp
邀请链接:网页链接
亲测deepseek接入word,自由调用对话,看截图有兴趣的复用代码(当然也可以自己向deepseek提问,帮助你完成接入,但是提问逻辑不一样给出的答案是千差万别的)项目首页 - VBA-JSONVBA中的JSON转换与解析工具:VBA-JSON:VBA中的JSON转换与解析工具VBA-JSON 是一个专为 VBA(Visual Basic for Applications)设计的 JSON 转换和解析工具 - GitCode
建议:去硅基流动申请,API响应较快速准确稳定
' 在用户窗体代码模块中添加以下代码
Private Sub btnSubmit_Click()On Error GoTo ErrorHandlerDim apiKey As StringDim apiUrl As StringDim jsonBody As StringDim responseText As String' 配置API信息(需替换为实际值)apiKey = "sk-f5e25a3127de4e2e928d1800c7820e08"apiUrl = "https://api.deepseek.com/v1/chat/completions" ' 示例URL' 构建请求体jsonBody = "{"jsonBody = jsonBody & """model"": ""deepseek-chat"","jsonBody = jsonBody & """messages"": [{""role"": ""user"", ""content"": """ & Me.txtQuery.text & """}]"jsonBody = jsonBody & "}"' 发送请求responseText = SendAPIRequest(apiUrl, apiKey, jsonBody)' 解析并插入结果InsertFormattedResponse (ParseResponse(responseText))Me.lblStatus.Caption = "处理成功!"Exit SubErrorHandler:Me.lblStatus.Caption = "错误: " & Err.Description
End Sub' API请求函数
Private Function SendAPIRequest(url As String, key As String, body As String) As StringDim http As ObjectSet http = CreateObject("MSXML2.XMLHTTP")http.Open "POST", url, Falsehttp.setRequestHeader "Content-Type", "application/json"http.setRequestHeader "Authorization", "Bearer " & keyhttp.send bodyIf http.Status = 200 ThenSendAPIRequest = http.responseTextElseErr.Raise vbObjectError + 1, , "API请求失败: " & http.Status & " - " & http.StatusTextEnd If
End Function' JSON响应解析(简单实现)
Private Function ParseResponse(json As String) As StringDim result As StringDim startPos As LongDim endPos As LongstartPos = InStr(json, """content"":""") + 10endPos = InStr(startPos, json, """,""")If startPos > 10 And endPos > startPos Thenresult = Mid(json, startPos, endPos - startPos)result = Replace(result, "\n", vbCrLf)result = Replace(result, "\""", """")ParseResponse = resultElseErr.Raise vbObjectError + 2, , "响应解析失败"End If
End Function' 排版输出函数
Private Sub InsertFormattedResponse(text As String)With ActiveDocument.Range.InsertAfter vbCrLf & "【DeepSeek响应】" & vbCrLf.Font.Bold = True.Font.Color = RGB(0, 102, 204).InsertAfter text & vbCrLf.Font.Bold = False.Font.Color = RGB(0, 0, 0)' 添加分隔线.InsertAfter String(50, "=") & vbCrLf.Font.Color = RGB(169, 169, 169)End With
End Sub