hi，大家好呀！

最近，哪吒太火了，票房还在持续增长，大家来猜猜看，最终哪吒的票房能有多高！

那今天我们是要来分享哪吒相关的内容吗？当然不是了！今天我们还是来讲DeepSeek，上周我们发了一个Access接入DeepSeek的视频，大家都在等我的源码文章，今天，源码就来啦，各位来跟我一起开发吧。

来吧，大家跟着我一起来做吧！开始前，各位客官老爺不要忘记给一键三连哦！

1、申请APIKeys

在开发之前，我们先要打开官网，在官网申请一个APIKeys，具体的入口如图：

在接口的申请页面，找到创建API key，点击输入一个名称，系统会自动给你生成一个key，生成的Key一定要复制保存，如果没有复制保存，那就只能重新操作一下了。

注意，这个API Key是关键哦！

2、创建窗体

在生成API key之后，我们就可以在Access中进行操作了，我们需要先创建一个窗体，在窗体上放几个控件，具体的如图：

3、添加代码

窗体做好了，我们就可以来写代码了，我们先来添加按钮的单击事件，具体的代码如下：

Private Function DeepSeekAI()

    On Error GoTo ErrorHandler

    Dim url As String

    Dim xmlhttp As Object

    Dim Response As String

    Dim requestBody As String

    Dim apiKey As String

    Dim statusCode As String

    

    ' 设置接口URL

    

    url = "https://api.deepseek.com/chat/completions"

    

    apiKey =“你自己申请的API Key”

    ' 构建请求体（根据DeepSeek API要求调整）

    requestBody = "{""model"": ""deepseek-chat"", ""messages"": [{""role"": ""user"", ""content"": """ & Me.txtQ & """}], ""temperature"": 0.7,""max_tokens"":8192}"

    DoCmd.Hourglass True

    Me.lblMsg.Caption = "正在思考，请等待……"

    Me.Requery

    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")

    '     Debug.Print token, url

    xmlhttp.Open "POST", url, False

    xmlhttp.setRequestHeader "Content-Type", "application/json"

    xmlhttp.setRequestHeader "Authorization", "Bearer " & apiKey

    xmlhttp.send requestBody

    statusCode = xmlhttp.Status

    Response = xmlhttp.responseText

    '        Debug.Print Response

    xmlhttp.abort

    

    ' 检查HTTP状态码

    If statusCode <> 200 Then

        GoTo HttpError

    End If

    

    DeepSeekAI = Response

     Me.lblMsg.Caption = "问题回答结束。"

     Me.Requery

    '======================== 错误处理模块 ========================

    

ExitHere:

    

    DoCmd.Hourglass False

    Exit Function

    

    

HttpError:

    MsgBox "HTTP请求失败：" & vbCrLf & _

        "状态码：" & statusCode & vbCrLf & _

        "响应内容：" & Response

    

    Resume ExitHere

    

ApiError:

    MsgBox "API返回错误：" & vbCrLf & _

        ParseApiErrorMessage(Response) ' 解析错误消息

    

    Resume ExitHere

    

ErrorHandler:

    MsgBox "错误：" & vbCrLf & _

        "错误号：" & Err.Number & vbCrLf & _

        "描述：" & Err.Description

    Resume ExitHere

End Function



Function ParseApiErrorMessage(json As String) As String

    On Error GoTo ParseError

    Dim jsonObj As Object

    Set jsonObj = JsonConverter.ParseJson(json)

    ParseApiErrorMessage = jsonObj("error")("message")

    Exit Function

ParseError:

    ParseApiErrorMessage = "无法解析错误信息"

End Function

Private Sub btnOK_Click()

    On Error GoTo ErrorHandler

    Dim json As Object

    Dim jsonObject As Object

    Dim strSQL As String

    

    If IsNull(Me.txtQ) Then

        MsgBox "请输入你的问题", vbExclamation

        Me.txtQ.SetFocus

        Exit Sub

    End If

    

    Set json = JsonConverter.ParseJson(DeepSeekAI())

    Me.txtMsg = json("choices")(1)("message")("content")

    MsgBox "生成成功。", vbInformation

ExitHere:

    

    Exit Sub

ErrorHandler:

    MsgBox Err.Description, vbCritical, "#错误"

    Resume ExitHere

End Sub



Private Sub Form_Load()

    Me.lblMsg.Caption = "请输入你的问题"

End Sub

注意替换自己申请的API Key

另外，我们这里还用到了一个JSon的解析库，具体的地址：https://github.com/VBA-tools/VBA-JSON

通过github下载下来后，我们只需要其中的“JsonConverter.bas” 这个模块

4、运行测试

最后，就是测试了，我们就可以直接在Access中与AI沟通了。因为DeepSeek的知识库截止日期是2024年7月，所以我们现在问哪吒2的问题，全出现这样的回答。

不管它回答的怎么样，但至少我们的功能成功了，大家快去试一下吧！

如果看到这里了，还不给我一键三连！谢谢大家！