如何使用VBA通过POST请求上传pdf文件

Question

我正在尝试使用他们的 API 创建一个 VBA 脚本来将 .pdf 文件上传到 Pipedrive。虽然我可以创建 API 所需的多部分/表单数据，但在对纯文本以外的任何其他文件进行编码时会出现问题，当出现问题时，文件会被上传，但我认为它的二进制内容最终会出错，使其变为空白。

API 要求发送文件的方式如下：

完整文档在这里：https://developers.pipedrive.com/docs/api/v1/Files#addFile

我对使用 API 还很陌生，所以我在这里有点迷失，我不完全确定应该如何准备文件以将其添加到表单数据中。

我正在尝试以下脚本

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
    
    ' Set the file path and custom filename
    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
    
    ' Read the file as binary data
    Dim fileStream As Object
    Set fileStream = CreateObject("ADODB.Stream")
    fileStream.Type = 1 ' Binary
    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

澄清一下，请求响应成功，一切似乎都工作正常，我可以在那里看到文件并“正常”打开它。 然而，该文件只是空白。

----修复和响应----

• 尝试修复 aplication/pdf 上的拼写错误，但这似乎并没有导致问题：

 bodyContent = bodyContent & "Content-Type: application/pdf" & vbCrLf &
 vbCrLf

• 尝试将网址从“https://yourCompanyHere.pipedrive.com/api/v1/files/?api_token=yourTokenHere”修复为“https://yourCompanyHere.pipedrive.com/api/v1/files?api_token=yourTokenHere” ，但 API 似乎接受两种方式；
• 当“出错”时，API 仍然接受请求，并发送成功：

{"成功":true,"数据":{"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”：“通过 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"}}

• 我尝试用记事本打开原始文件和上传的文件来检查它们的内容，虽然“文本”内容似乎是相同的，但当我比较它们的二进制内容时，它是不同的。后来我意识到记事本将原始文件识别为 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

Answer 1

在这里找到了一个工作版本：https://stackoverflow.com/a/64650121/478884

完整工作代码如下：

Public Sub UploadFile()
    Dim sFormData, bFormData
    Dim d As String, DestURL As String, fileName As String, FilePath As String, FieldName As String, CONTENT As String
    
    Const TOKEN As String = "YOUR_API_TOKEN_HERE"
    Const BOUNDARY As String = "---------------------------0123456789012"
    Const DEALID As String = "9822"
    
    FieldName = "file"
    DestURL = "https://COMPANY_DOMAIN.pipedrive.com/api/v1/files?api_token=" & TOKEN
    fileName = "PDFFILE.pdf"
    CONTENT = "application/pdf"
    
    FilePath = "C:\..." + fileName
  
    Dim File, FILESIZE
    Set ado = CreateObject("ADODB.Stream")
    ado.Type = 1 'binary
    ado.Open
    ado.LoadFromFile FilePath
    ado.Position = 0
    FILESIZE = ado.Size
    File = ado.Read
    ado.Close
  
    Set ado = CreateObject("ADODB.Stream")
    d = "--" + BOUNDARY + vbCrLf
    d = d + "Content-Disposition: form-data; name=""deal_id""" & vbCrLf & vbCrLf
    d = d + DEALID & vbCrLf
    d = d + "--" + BOUNDARY + vbCrLf
    d = d + "Content-Disposition: form-data; name=""" + FieldName + """;"
    d = d + " filename=""" + fileName + """" + vbCrLf
    d = d + "Content-Type: " & CONTENT + vbCrLf + vbCrLf
    ado.Type = 1 'binary
    ado.Open
    ado.Write ToBytes(d)
    ado.Write File
    ado.Write ToBytes(vbCrLf + "--" + BOUNDARY + "--" + vbCrLf)
    ado.Position = 0
    
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "POST", DestURL, False
        .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & BOUNDARY
        .send ado.Read
        
        Debug.Print .responseText
    End With
End Sub

Function ToBytes(str As String) As Variant
    Dim ado As Object
    Set ado = CreateObject("ADODB.Stream")
    ado.Open
    ado.Type = 2 ' text
    ado.Charset = "_autodetect"
    ado.WriteText str
    ado.Position = 0
    ado.Type = 1
    ToBytes = ado.Read
    ado.Close
End Function