VBA send file in binary code to API via POST method - vba

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"