VBA send file in binary code to API via POST method

Question

I have last problem with my code. Code sending via POST variables from Outlook to API.

My last problem is how to send variables and mail attachment in one POST request to API.

first 7zip comprimation for mail attachement:

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

Now i have c:\attachment\attachment.zip

Next part is send variables to 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

Variables are sended, but fileAttachment is send as a string, so API get path where file is saved.

My question is how implement code below (found on internet) to my code sendDataToApi and POST attachment.zip as a binary insteed of string.

    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

UPDATE:

when i added part of code from @Tim Williams

in my database is saved file as /tmp/phpAJOtVw what do i doing wrong ?

Answer 1

Upload is a standalone method, so you should be able to call it something like this:

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, "&", "|")

You should remove these hard-coded values from the top of Upload:

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