摘要：SendTxt = "{""model"": ""deepseek-chat"", ""messages"": [{""role"":""system"", ""content"":""deepseek AI助手""}, {""role"":""user"",
Function CallDeepSeekAPI(api_key As String, inputText As String) As String
Dim API As String
Dim SendTxt As String
Dim Http As Object
Dim status_code As Integer
Dim response As String
API = "https://api.deepseek.com/chat/completions"
SendTxt = "{""model"": ""deepseek-chat"", ""messages"": [{""role"":""system"", ""content"":""deepseek AI助手""}, {""role"":""user"", ""content"":""" & inputText & """}], ""stream"": false}"
Set Http = CreateObject("MSXML2.XMLHTTP")
With Http
.Open "POST", API, False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Authorization", "Bearer " & api_key
.send (SendTxt)
status_code = .Status
response = .responseText
End With
' 调试代码，用于查看调用返回结果
'MsgBox "API 返回结果: " & response, vbInformation, "调试信息"
If status_code = 200 Then
CallDeepSeekAPI = response
Else
CallDeepSeekAPI = "Error: " & status_code & " - " & response
End If
Set Http = Nothing
End Function
Sub DeepSeekV3
Dim api_key As String
Dim inputText As String
Dim response As String
Dim regex As Object
Dim matches As Object
Dim originalSelection As Object
api_key = "请替换为deepseek官方申请的apikey"
If api_key = "" Then
MsgBox "请输入deepseek官方申请的 API key."
Exit Sub
ElseIf Selection.Type wdSelectionNormal Then
MsgBox "请选择文本内容"
Exit Sub
End If
' 保存原始选中的文本
Set originalSelection = Selection.Range.Duplicate
inputText = Replace(Replace(Replace(Replace(Replace(Selection.Text, "\", "\\"), vbCrLf, ""), vbCr, ""), vbLf, ""), Chr(34), "\""")
response = CallDeepSeekAPI(api_key, inputText)
If Left(response, 5) "Error" Then
Set regex = CreateObject("VBScript.RegExp")
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = """content"":""(.*?)"""
End With
Set matches = regex.Execute(response)
If matches.Count > 0 Then
response = matches(0).SubMatches(0)
response = Replace(Replace(response, """", Chr(34)), """", Chr(34))
' 取消选中原始文本
Selection.Collapse Direction:=wdCollapseEnd
' 将内容插入到选中文字的下一行
Selection.TypeParagraph
' 插入新行
Selection.TypeText Text:=response
' 将光标移回原来选中文本的末尾
originalSelection.Select
Else
MsgBox "解析 API返回的内容失败", vbExclamation
End If
Else
MsgBox response, vbCritical
End If
End Sub
来源：野望拾光