当前位置：首页 > news >正文

Deepseek 接入Word处理对话框（隐藏密钥）

news 2025/9/7 2:16:45

硅基流动邀请码：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 ErrorHandler
    
    Dim apiKey As String
    Dim apiUrl As String
    Dim jsonBody As String
    Dim 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 Sub

ErrorHandler:
    Me.lblStatus.Caption = "错误: " & Err.Description
End Sub

' API请求函数
Private Function SendAPIRequest(url As String, key As String, body As String) As String
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    http.Open "POST", url, False
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "Authorization", "Bearer " & key
    
    http.send body
    
    If http.Status = 200 Then
        SendAPIRequest = http.responseText
    Else
        Err.Raise vbObjectError + 1, , "API请求失败: " & http.Status & " - " & http.StatusText
    End If
End Function

' JSON响应解析（简单实现）
Private Function ParseResponse(json As String) As String
    Dim result As String
    Dim startPos As Long
    Dim endPos As Long
    
    startPos = InStr(json, """content"":""") + 10
    endPos = InStr(startPos, json, """,""")
    
    If startPos > 10 And endPos > startPos Then
        result = Mid(json, startPos, endPos - startPos)
        result = Replace(result, "\n", vbCrLf)
        result = Replace(result, "\""", """")
        ParseResponse = result
    Else
        Err.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