使用VBA通过POST请求上传PDF到Pipedrive API时文件空白问题

我用VBA调用Pipedrive API上传PDF文件时，能生成符合要求的multipart/form-data请求体，但上传后的文件打开是空白的——虽然API返回成功，文件也能在交易页面显示，但内容完全丢失。

参考Pipedrive官方API的文件上传接口（Files#addFile），我尝试了以下代码：

Sub testFileAPI()
    Const COMPANY_DOMAIN As String = "COMPANY DOMAIN"
    Const AUTH_KEY As String = "9999999999999999999"
    Const BOUNDARY As String = "974767299852498929531610575"
    
    Dim request As Object
    Set request = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    
    Dim URL As String
    Dim body As String
    Dim filePath As String
    Dim customFileName As String
    Dim dealID As Integer
    
    URL = "https://" & COMPANY_DOMAIN & ".pipedrive.com/api/v1/files/" & "?api_token=" & AUTH_KEY
    dealID = 9822
    
    ' 设置文件路径和自定义文件名
    filePath = "\test.pdf"
    customFileName = "test123.pdf"
    
    body = createFormData(BOUNDARY, filePath, customFileName, dealID)
    
    request.Open "POST", URL, False
    request.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & BOUNDARY
    
    request.send body
    
    Debug.Print request.responseText
End Sub

Public Function createFormData(ByVal BOUNDARY As String, ByVal filePath As String, ByVal customFileName As String, ByVal dealID As Integer) As String
    Dim bodyContent As String
    
    ' 读取文件二进制数据
    Dim fileStream As Object
    Set fileStream = CreateObject("ADODB.Stream")
    fileStream.Type = 1 ' 二进制模式
    fileStream.Open
    fileStream.LoadFromFile filePath
    Dim fileData() As Byte
    fileData = fileStream.Read
    fileStream.Close
    
    bodyContent = "--" & BOUNDARY & vbCrLf
    bodyContent = bodyContent & "Content-Disposition: form-data; name=""file""; filename=""" & customFileName & """" & vbCrLf
    bodyContent = bodyContent & "Content-Type: application/pdf" & vbCrLf & vbCrLf
    bodyContent = bodyContent & ByteArrayToBinaryString(fileData) & vbCrLf
    bodyContent = bodyContent & "--" & BOUNDARY & vbCrLf
    bodyContent = bodyContent & "Content-Disposition: form-data; name=""deal_id""" & vbCrLf & vbCrLf
    bodyContent = bodyContent & dealID & vbCrLf
    bodyContent = bodyContent & "--" & BOUNDARY & "--"
    
    createFormData = bodyContent
End Function

问题现象 #

请求返回成功，文件能在交易页面找到，但打开后完全空白。API返回的响应示例：

{"success":true,"data":{"id":72381,"user_id":7869030,"log_id":null,"add_time":"2023-09-02 17:26:09","update_time":"2023-09-02 17:26:09","file_name":"e70986db-e555-47b5-9e42-5b5edca8b1a9.pdf","file_size":48089,"active_flag":true,"inline_flag":false,"remote_location":"s3","remote_id":"company/9999999/user/7869030/files/e70986db-e555-47b5-9e42-5b5edca8b1a9.pdf","s3_bucket":null,"url":"https://COMPANYDOMAIN.pipedrive.com/api/v1/files/72381/download","name":"test123.pdf","description":null,"deal_id":9822,"lead_id":null,"person_id":19122,"org_id":null,"product_id":null,"activity_id":null,"deal_name":"Sent through Excel","lead_name":null,"person_name":"NAME","org_name":null,"product_name":null,"mail_message_id":null,"mail_template_id":null,"cid":null,"file_type":"pdf"}}

已尝试的修复 #

• 修正Content-Type拼写错误，无效
• 调整URL格式，API支持两种格式，无效
• 对比原文件和上传文件的二进制内容，发现原文件是ANSI编码，上传后变成UTF-8，推测问题出在编码转换。当前使用的二进制转字符串函数：

Function ByteArrayToBinaryString(ByRef ByteArray() As Byte) As String
    Dim binaryString As String
    Dim I As Long
    For I = LBound(ByteArray) To UBound(ByteArray)
        binaryString = binaryString & Chr(ByteArray(I))
    Next I
    ByteArrayToBinaryString = binaryString
End Function

解决方案 #

问题根源是将二进制数据转成字符串时发生了编码转换——VBA的字符串是Unicode编码，直接用Chr()转换字节会破坏二进制数据（比如PDF中的非ASCII字节会被错误解析）。正确的做法是用ADODB.Stream将整个multipart请求体拼接成二进制数据流，避免字符串转换。

修正后的代码：

Sub testFileAPI()
    Const COMPANY_DOMAIN As String = "COMPANY DOMAIN"
    Const AUTH_KEY As String = "9999999999999999999"
    Const BOUNDARY As String = "974767299852498929531610575"
    
    Dim request As Object
    Set request = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    
    Dim URL As String
    Dim requestStream As Object
    Dim filePath As String
    Dim customFileName As String
    Dim dealID As Integer
    
    URL = "https://" & COMPANY_DOMAIN & ".pipedrive.com/api/v1/files/?api_token=" & AUTH_KEY
    dealID = 9822
    filePath = "\test.pdf"
    customFileName = "test123.pdf"
    
    ' 创建请求流
    Set requestStream = CreateObject("ADODB.Stream")
    requestStream.Type = 1 ' 二进制模式
    requestStream.Open
    
    ' 写入form-data头部
    WriteTextToStream requestStream, "--" & BOUNDARY & vbCrLf
    WriteTextToStream requestStream, "Content-Disposition: form-data; name=""file""; filename=""" & customFileName & """" & vbCrLf
    WriteTextToStream requestStream, "Content-Type: application/pdf" & vbCrLf & vbCrLf
    
    ' 写入文件二进制数据
    Dim fileStream As Object
    Set fileStream = CreateObject("ADODB.Stream")
    fileStream.Type = 1
    fileStream.Open
    fileStream.LoadFromFile filePath
    fileStream.CopyTo requestStream
    fileStream.Close
    
    ' 写入deal_id字段
    WriteTextToStream requestStream, vbCrLf & "--" & BOUNDARY & vbCrLf
    WriteTextToStream requestStream, "Content-Disposition: form-data; name=""deal_id""" & vbCrLf & vbCrLf
    WriteTextToStream requestStream, CStr(dealID) & vbCrLf
    
    ' 写入结束边界
    WriteTextToStream requestStream, "--" & BOUNDARY & "--"
    
    ' 发送请求
    request.Open "POST", URL, False
    request.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & BOUNDARY
    requestStream.Position = 0
    request.send requestStream
    
    Debug.Print request.responseText
    
    requestStream.Close
End Sub

' 辅助函数：将文本转成UTF-8字节写入二进制流
Sub WriteTextToStream(ByRef stream As Object, ByVal text As String)
    Dim textStream As Object
    Set textStream = CreateObject("ADODB.Stream")
    textStream.Type = 2 ' 文本模式
    textStream.Charset = "UTF-8"
    textStream.Open
    textStream.WriteText text
    textStream.Position = 0
    textStream.Type = 1 ' 转二进制模式
    textStream.CopyTo stream
    textStream.Close
End Sub

代码说明

1. 用ADODB.Stream直接构建二进制请求体，避免字符串转换导致的编码损坏
2. 文本部分（边界、表单字段）转成UTF-8字节写入流，符合HTTP标准
3. 文件二进制数据直接复制到请求流，完整保留原始内容

内容的提问来源于stack exchange，提问作者Eric Dutra