VBA通过POST方法向API发送二进制代码文件。

Question

我的代码出现了最后一个问题。代码通过POST变量从Outlook发送至API。

我最后的问题是如何在一个POST请求中发送变量和邮件附件到API。

首先7zip压缩的邮件附件。

strSource = cstrFileAttachment & "*.*"
strTarget = cstrFileattachment & "Zip\attachment.zip"
strPassword = randomPassword(cintLongPassword)
strCommand = """" & PathZipProgram & """ a -tzip """ & strTarget & _
    """ -p" & strPassword & " """ & strSource & """"

现在我有 c:\attachment\attachment.zip

下一部分是发送变量到API。

    Dim SendDataToApi As String


    strFrom = 1


    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")

    URL = "https://url.domain.com/api/data"

    objHTTP.Open "POST", URL, False
    objHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"


    SendDataToApi = "mail_from=" & strFrom & "&mail_to=" & strKomu & "&file_attachment=" & fileAttachment & "&url_attribute=" & strWebLink & "&sms_code=" & strHeslo & "&id_message=" & IdMessage & "&mobile_phone=" & strPhone & "&date_send=" & strDateSend & "&date_expiration=" & strDateExp

    objHTTP.Send SendDataToApi

变量被发送，但fileAttachment是作为一个字符串发送的，所以API得到文件保存的路径。

我的问题是如何实现下面的代码（在网上找到的）到我的代码中去 sendDataToApi 并将attachment.zip作为二进制文件而不是字符串发送。

    Private Function Upload(strUploadUrl, strFilePath, strFileField, strDataPairs)
    'Uses POST to upload a file and miscellaneous form data
    strUploadUrl = "https://url.domain.com/api/data"
    strFilePath = cstrFilepathAttachment & "Zip\attachment.zip"
    'strFileField is the web page equivalent form field name for the file (File1)
    'strDataPairs are pipe-delimited form data pairs (foo=bar|snap=crackle)
    Const MULTIPART_BOUNDARY = "---------------------------0123456789012"
    Dim ado, rs
    Dim lngCount
    Dim bytFormData, bytFormStart, bytFormEnd, bytFile
    Dim strFormStart, strFormEnd, strDataPair
    Dim web
    Const adLongVarBinary = 205
        'Read the file into a byte array
        Set ado = CreateObject("ADODB.Stream")
        ado.Type = 1
        ado.Open
        ado.LoadFromFile strFilePath
        bytFile = ado.Read
        ado.Close
        'Create the multipart form data.
        'Define the end of form
        strFormEnd = vbCrLf & "--" & MULTIPART_BOUNDARY & "--" & vbCrLf
        'First add any ordinary form data pairs
        strFormStart = ""
        For Each strDataPair In Split(strDataPairs, "|")
            strFormStart = strFormStart & "--" & MULTIPART_BOUNDARY & vbCrLf
            strFormStart = strFormStart & "Content-Disposition: form-data; "
            strFormStart = strFormStart & "name=""" & Split(strDataPair, "=")(0) & """"
            strFormStart = strFormStart & vbCrLf & vbCrLf
            strFormStart = strFormStart & Split(strDataPair, "=")(1)
            strFormStart = strFormStart & vbCrLf
        Next
        'Now add the header for the uploaded file
        strFormStart = strFormStart & "--" & MULTIPART_BOUNDARY & vbCrLf
        strFormStart = strFormStart & "Content-Disposition: form-data; "
        strFormStart = strFormStart & "name=""" & strFileField & """; "
        strFormStart = strFormStart & "filename=""" & Mid(strFilePath, InStrRev(strFilePath, "\") + 1) & """"
        strFormStart = strFormStart & vbCrLf
        strFormStart = strFormStart & "Content-Type: application/upload" 'bogus, but it works
        strFormStart = strFormStart & vbCrLf & vbCrLf
        'Create a recordset large enough to hold everything
        Set rs = CreateObject("ADODB.Recordset")
        rs.Fields.Append "FormData", adLongVarBinary, Len(strFormStart) + LenB(bytFile) + Len(strFormEnd)
        rs.Open
        rs.AddNew
        'Convert form data so far to zero-terminated byte array
        For lngCount = 1 To Len(strFormStart)
            bytFormStart = bytFormStart & ChrB(Asc(Mid(strFormStart, lngCount, 1)))
        Next
        rs("FormData").AppendChunk bytFormStart & ChrB(0)
        bytFormStart = rs("formData").GetChunk(Len(strFormStart))
        rs("FormData") = ""
        'Get the end boundary as a zero-terminated byte array
        For lngCount = 1 To Len(strFormEnd)
            bytFormEnd = bytFormEnd & ChrB(Asc(Mid(strFormEnd, lngCount, 1)))
        Next
        rs("FormData").AppendChunk bytFormEnd & ChrB(0)
        bytFormEnd = rs("formData").GetChunk(Len(strFormEnd))
        rs("FormData") = ""
        'Now merge it all
        rs("FormData").AppendChunk bytFormStart
        rs("FormData").AppendChunk bytFile
        rs("FormData").AppendChunk bytFormEnd
        bytFormData = rs("FormData")
        rs.Close
        'Upload it
        Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
        web.Open "POST", strUploadUrl, False
        web.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & MULTIPART_BOUNDARY
        web.Send bytFormData
    End Function

更新。

当我添加了部分来自@Tim Williams的代码时。

在我的数据库中保存的文件是 /tmp/phpAJOtVw 我做错了什么？

Answer 1

Upload 是一个独立的方法，所以你应该能够像这样调用它。

sUrl = "https://url.domain.com/api/data"  'API endpoint

fPath = "c:\attachment\attachment.zip"    'attachment location

FileFieldName = "checkYourApiForThis"     'API specifies this

DataPairs = "mail_from=" & strFrom & _
                "&mail_to=" & strKomu & _
                "&file_attachment=" & fileAttachment & _
                "&url_attribute=" & strWebLink & _
                "&sms_code=" & strHeslo & _
                "&id_message=" & IdMessage & _
                "&mobile_phone=" & strPhone & _
                "&date_send=" & strDateSend & _
                "&date_expiration=" & strDateExp

'call the function
'expects |-delimited name/value pairs, not &, so do a replace
Upload sUrl, fPath, FileFieldName, Replace(DataPairs, "&", "|")

你应该把这些硬编码的值从顶部删除掉 Upload:

strUploadUrl = "https://url.domain.com/api/data"
strFilePath = cstrFilepathAttachment & "Zip\attachment.zip"