Excel接入deepseek

先进入deepseek官网：DeepSeek | 深度求索

点击API开放平台：

确保余额里有钱:

创建APIkey:

复制到.txt文件中储存好

---

插入VBA代码：

Function OptimizeEbayTitle(originalTitle As String) As String
    Dim Prompt As String
    Prompt = "作为专业eBay运营人员，请优化以下标题：[[" & originalTitle & "]]" & vbCrLf & _
             "要求：" & vbCrLf & _
             "1. 控制在80个字符以内" & vbCrLf & _
             "2. 保留核心信息" & vbCrLf & _
             "3. 直接输出优化结果，不加额外说明或符号"
             
    OptimizeEbayTitle = AskAI(Prompt)
    
    ' 如果结果包含引号，移除它们
    OptimizeEbayTitle = Replace(Replace(OptimizeEbayTitle, """", ""), """, "")
End Function

Function AskAI(Prompt As String) As String
    Dim jsonResponse As String
    Dim contentStart As Long
    Dim contentEnd As Long
    Dim contentText As String
    
    ' 获取API原始响应
    jsonResponse = DeepSeek_Query(Prompt)
    
    ' 检查是否有错误
    If Left(jsonResponse, 5) = "Error" Or Left(jsonResponse, 5) = "HTTP" Then
        AskAI = jsonResponse ' 直接返回错误信息
        Exit Function
    End If
    
    ' 尝试定位content字段
    contentStart = InStr(1, jsonResponse, """content"":""") + Len("""" & "content" & """:""")
    
    If contentStart > Len("""" & "content" & """:""") Then
        ' 查找content结束位置
        contentEnd = InStr(contentStart, jsonResponse, """")
        
        If contentEnd > contentStart Then
            ' 提取内容
            contentText = Mid(jsonResponse, contentStart, contentEnd - contentStart)
            
            ' 反转义特殊字符
            contentText = Replace(contentText, "\""", """")   ' 双引号
            contentText = Replace(contentText, "\n", vbCrLf)  ' 换行符
            contentText = Replace(contentText, "\\", "\")     ' 反斜杠
            
            AskAI = contentText
            Exit Function
        End If
    End If
    
    ' 如果无法解析，返回原始JSON的前100字符
    AskAI = "无法解析响应: " & Left(jsonResponse, 100)
End Function

' 原始API调用函数（保持不变）
Function DeepSeek_Query(Prompt As String) As String
    Dim Http As Object
    Dim Url As String, APIKey As String
    Dim Body As String
    
    APIKey = "" ' 替换为真实API密钥
    Url = "https://api.deepseek.com/v1/chat/completions"
    
    Set Http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    
    On Error GoTo ErrorHandler
    
    ' 特殊字符转义处理
    Dim SafePrompt As String
    SafePrompt = Replace(Prompt, """", "\""")
    SafePrompt = Replace(SafePrompt, vbCrLf, "\n")
    SafePrompt = Replace(SafePrompt, "\", "\\")
    
    Body = "{""model"":""deepseek-chat"",""messages"":[{""role"":""user"",""content"":""" & SafePrompt & """}]}"
    
    Http.Open "POST", Url, False
    Http.setRequestHeader "Content-Type", "application/json"
    Http.setRequestHeader "Authorization", "Bearer " & APIKey
    Http.send Body
    
    If Http.Status <> 200 Then
        DeepSeek_Query = "HTTP错误 " & Http.Status & ": " & Http.statusText
        Exit Function
    End If
    
    DeepSeek_Query = Http.responseText
    Exit Function
    
ErrorHandler:
    DeepSeek_Query = "VBA错误: " & Err.Description
End Function

效果展示：