I'm trying to upload files to a web service using VBA, following the form-data multipart structure sent when uploading documents via web browser, however I'm receiving the "400: Invalid multipart payload format" response, despite sending (from what i can tell) an identical payload in the request.
For my test case I've created a txt document named test.txt that contains "TestContents" within. I've uploaded this file using the web browser and have also attempted this with VBA (shown below). Spending some time comparing the payload from Chrome with my own VBA generated payload i can't see any differences.
I'm using the following code to create and send the multipart payload to the web service (URL partly obfuscated) and have used the following question to help re-write this a few times in the pursuit of solving this issue: [https://stackoverflow.com/questions/50110601/upload-a-picture-to-file-io-http-post-in-vba]
(Apologies for any mess within - I've been changing and re-writing this for quite while now so there might be some untidyness)
Private Function toArray(inData As String)
Dim objADODB As Object: Set objADODB = CreateObject("ADODB.Stream")
objADODB.Type = 2
objADODB.Charset = "_autodetect"
objADODB.Open
objADODB.WriteText (inData)
objADODB.Position = 0
objADODB.Type = 1
toArray = objADODB.Read()
Set objADODB = Nothing
End Function
Private Function readBinary(filePath As String)
Dim objADODB As Object: Set objADODB = CreateObject("ADODB.Stream")
objADODB.Type = 1
objADODB.Open
objADODB.LoadFromFile filePath
readBinary = objADODB.Read
objADODB.Close
Set objADODB = Nothing
End Function
Public Sub sendDocument(ByVal inID As String, ByVal tags As String, ByVal docContentType As String, ByVal docFilePath As String)
Dim objADODB As Object
Dim objHTTP As Object
Dim boundary As String: boundary = "----WebKitFormBoundaryeeYChAY7UlBEI63d" 'Set like this so i can debug like-for-like with browser payload
Dim docFileName As String: docFileName = Mid(docFilePath, InStrRev(docFilePath, "\") 1)
'(structure is file, material, tags if there are any)
Set objADODB = CreateObject("ADODB.Stream")
With objADODB
.Type = 1
.Open
.Write toArray("--" & boundary & Chr(10))
.Write toArray("Content-Disposition: form-data; name=""file""; filename=""" & docFileName & """" & Chr(10) & _
"Content-Type: " & docContentType & Chr(10) & Chr(10))
.Write readBinary(docFilePath)
.Write toArray(Chr(10) & "--" & boundary & Chr(10))
.Write toArray("Content-Disposition: form-data; name=""material""" & Chr(10) & Chr(10) & inID & Chr(10))
If tags <> "" Then .Write toArray("Content-Disposition: form-data; name=""tags""" & Chr(10) & Chr(10) & tags & Chr(10))
.Write toArray("--" & boundary & "--")
.Position = 0
End With
If Not validateID(inID) Then
MsgBox ("ID must be 4-5 digits long")
Exit Sub
End If
If auth = "" Then
MsgBox "Login is required. Click OK to log in"
Call getAuth
End If
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
With objHTTP
.Open "POST", "https://xxx.xxx/hapi/document", False
.setRequestHeader "Authorization", auth
.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & boundary
.send (objADODB.Read())
MsgBox .responseText
End With
bStatusOK = objHTTP.status = 200
If objHTTP.status = 401 Then
MsgBox ("Login is invalid/expired. Please reauthenticate")
Call getAuth
End If
End Sub
The above produces a payload identical to what is present in Chrome's inspector window when viewing form data for the request, which is:
------WebKitFormBoundaryeeYChAY7UlBEI63d
Content-Disposition: form-data; name="file"; filename="Test.txt"
Content-Type: text/plain
TestContents
------WebKitFormBoundaryeeYChAY7UlBEI63d
Content-Disposition: form-data; name="material"
16145
------WebKitFormBoundaryeeYChAY7UlBEI63d--
I'm starting to suspect that it's not encoded correctly. I note that the browser call uses the header
Accept-Encoding: gzip, deflate, br
..which when i attempt to replicate this or any single type (except br), I still get the same message but replied in a format that the VBA locals window cannot understand. I have had success with other POST and PUT requests sending JSON or text payloads without needing to specify Accept-Encoding so I'm not sure if this is the right path to continue on.
If anybody is able to provide some help on this I would be incredibly grateful.
Thanks!
CodePudding user response:
If you have a tags parameter it will be missing the start boundary.
If tags <> "" Then
.Write toArray("--" & boundary & vbCrLf)
.Write toArray("Content-Disposition: form-data; name=""tags""" & vbCrLf & vbCrLf & tags & vbCrLf)
End If
CodePudding user response:
Solved thanks to CDP1802's comment! VbCrLf
was required instead of Chr(10)
.
The working section that builds the form data now looks like:
Set objADODB = CreateObject("ADODB.Stream")
With objADODB
.Type = 1
.Open
.Write toArray("--" & boundary & vbCrLf)
.Write toArray("Content-Disposition: form-data; name=""file""; filename=""" & docFileName & """" & vbCrLf & _
"Content-Type: " & docContentType & vbCrLf & vbCrLf)
.Write readBinary(docFilePath)
.Write toArray(vbCrLf & "--" & boundary & vbCrLf)
.Write toArray("Content-Disposition: form-data; name=""material""" & vbCrLf & vbCrLf & inID & vbCrLf)
If tags <> "" Then
.Write toArray("--" & boundary & vbCrLf)
.Write toArray("Content-Disposition: form-data; name=""tags""" & vbCrLf & vbCrLf & tags & vbCrLf)
End If
.Write toArray("--" & boundary & "--")
.Position = 0
End With