Excel VBA集成CHATPDF API实现合同预审及上传报错解决

错误根源 #

你遇到的400 BAD_REQUEST错误，核心原因是原代码错误地将PDF二进制内容转换为Unicode字符串，破坏了文件的原始二进制结构，导致ChatPDF API无法解析文件。此外，手动拼接字符串形式的multipart请求体，容易出现格式偏差，进一步加剧解析失败。

修正后的PDF上传代码 #

以下是修复后的VBA代码，可正确上传PDF文件并获取Source ID：

Sub UploadPDFToChatPDF()
    Dim http As Object
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    ' 配置参数
    Dim filePath As String
    filePath = "C:\Users\martind3\001.pdf" ' 替换为你的PDF路径
    Dim apiKey As String
    apiKey = "sec_xxxxxxxxxxxxxxxxx" ' 替换为你的ChatPDF API密钥
    Dim url As String
    url = "https://api.chatpdf.com/v1/sources/add-file"
    
    ' 定义边界符（可自定义，确保不与文件内容冲突）
    Dim boundary As String
    boundary = "----ChatPDFBoundary" & Format(Now(), "YYYYMMDDHHMMSS")
    
    ' 读取PDF二进制内容
    Dim fileBytes() As Byte
    Dim fileNum As Integer
    fileNum = FreeFile
    Open filePath For Binary Access Read As fileNum
    ReDim fileBytes(LOF(fileNum) - 1)
    Get fileNum, , fileBytes
    Close fileNum
    
    ' 构造Multipart请求体的字节数组
    Dim headerBytes() As Byte, footerBytes() As Byte
    Dim bodyBytes() As Byte
    
    ' 构造文件头部分
    Dim headerStr As String
    headerStr = "--" & boundary & vbCrLf & _
                "Content-Disposition: form-data; name=""file""; filename=""" & Dir(filePath) & """" & vbCrLf & _
                "Content-Type: application/pdf" & vbCrLf & vbCrLf
    headerBytes = StrConv(headerStr, vbFromUnicode)
    
    ' 构造尾部边界
    Dim footerStr As String
    footerStr = vbCrLf & "--" & boundary & "--" & vbCrLf
    footerBytes = StrConv(footerStr, vbFromUnicode)
    
    ' 合并所有字节数组：头 + 文件二进制 + 尾
    ReDim bodyBytes(UBound(headerBytes) + UBound(fileBytes) + UBound(footerBytes) + 2)
    Call CopyMemory(bodyBytes(0), headerBytes(0), UBound(headerBytes) + 1)
    Call CopyMemory(bodyBytes(UBound(headerBytes) + 1), fileBytes(0), UBound(fileBytes) + 1)
    Call CopyMemory(bodyBytes(UBound(headerBytes) + UBound(fileBytes) + 2), footerBytes(0), UBound(footerBytes) + 1)
    
    ' 发送请求
    http.Open "POST", url, False
    http.setRequestHeader "x-api-key", apiKey
    http.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & boundary
    http.send bodyBytes
    
    ' 处理响应
    If http.Status = 200 Then
        ' 需要引入JsonConverter模块解析响应
        Dim jsonObj As Object
        Set jsonObj = JsonConverter.ParseJson(http.responseText)
        MsgBox "上传成功，Source ID: " & jsonObj("sourceId")
        ' 可将Source ID存入指定单元格，比如A1
        ' Range("A1").Value = jsonObj("sourceId")
    Else
        MsgBox "上传失败，状态码: " & http.Status & vbCrLf & "错误信息: " & http.responseText
    End If
End Sub

' 需要添加CopyMemory声明（放在模块顶部）
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef Destination As Any, ByRef Source As Any, ByVal Length As LongPtr)

关键修改说明 #

• 保留二进制完整性：直接保留PDF的原始字节数组，不进行Unicode转换，确保文件结构未被破坏。
• 字节数组拼接请求体：通过CopyMemory合并请求头、文件内容和尾部边界，严格遵循multipart/form-data格式要求。
• 正确设置文件类型：使用application/pdf作为Content-Type，匹配ChatPDF API的解析标准。

后续：基于Source ID自动提问并填充Excel #

上传成功后，可通过以下代码调用ChatPDF API的提问接口，将预设问题的答案写入Excel对应列：

Sub QueryChatPDFAndFillAnswers()
    Dim http As Object
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    Dim apiKey As String
    apiKey = "sec_xxxxxxxxxxxxxxxxx" ' 替换为你的API密钥
    Dim sourceId As String
    sourceId = Range("A1").Value ' 假设Source ID存储在A1单元格
    
    ' 预设问题（可根据你的Excel列结构调整）
    Dim questions As Variant
    questions = Array( _
        "合同期限是多久？", _
        "违约时的处罚条款有哪些？", _
        "合同的付款方式是什么？" _
    )
    
    Dim i As Integer
    For i = LBound(questions) To UBound(questions)
        Dim url As String
        url = "https://api.chatpdf.com/v1/chats/message"
        
        ' 构造请求JSON
        Dim requestJson As String
        requestJson = "{""sourceId"":""" & sourceId & """,""messages"":[{""role"":""user"",""content"":""" & questions(i) & """}]}"
        
        ' 发送请求
        http.Open "POST", url, False
        http.setRequestHeader "x-api-key", apiKey
        http.setRequestHeader "Content-Type", "application/json"
        http.send requestJson
        
        ' 解析响应并写入Excel（假设从D列第3行开始写入答案）
        If http.Status = 200 Then
            Dim jsonObj As Object
            Set jsonObj = JsonConverter.ParseJson(http.responseText)
            Range("D" & i + 3).Value = jsonObj("content")
        Else
            Range("D" & i + 3).Value = "提问失败: " & http.responseText
        End If
    Next i
    
    MsgBox "合同预审完成，答案已填充至表格"
End Sub

注意事项 #

1. JsonConverter依赖：代码中使用JsonConverter.ParseJson解析响应，需将VBA-JSON模块导入到Excel VBA项目中（通过VBA编辑器的“工具-导入文件”添加）。
2. 权限与限制：确保API密钥权限正常，上传的PDF文件大小不超过ChatPDF API的限制。
3. 异常处理：可根据需求补充文件不存在、网络超时等场景的错误处理逻辑。

内容的提问来源于stack exchange，提问作者Diego Luque