VBA (Access) File upload via REST with Multipart Formdata - only works with txt-files-CodePudding

For a project I need to upload files from Access via (REST) web service (e.g. .accdb - files).

The upload now also works in principle, the file arrives at the destination in its full size.

However, what is strange and problematic: I can only open the .txt (simple textfile, regardless of how big it is) file again at the destination. All other file types (.accdb, .png., .jpg) are there but seem to be currupted or cannot be opened...

I can't see what I'm doing wrong in the code! Adjusting the "file type" to the respective file type was also unsuccessful.

I use the same method with Java too, all file types work here -> so I think my code is wrong and the webservice works...

Thanks if anyone sees my mistake...

Here is my code:


Public Sub POST_multipart_form_data(filePath As String)



    Dim oFields As Object, ado As Object
    Dim sBoundary As String, sPayLoad As String, GUID As String
    Dim fileType As String, fileExtn As String, fileName As String
    Dim sName As Variant
        Dim filesize As Long
    
    Dim authUser As String
    Dim authPass As String
    Dim url_add As String

    
        authUser = REST_ReadPropsFromFile.getJSONPROP_for_REST("username")
        authPass = REST_ReadPropsFromFile.getJSONPROP_for_REST("password")
        url_add = REST_ReadPropsFromFile.getJSONPROP_for_REST("url_add_doc")


    fileName = Right(filePath, Len(filePath) - InStrRev(filePath, "\"))
    fileExtn = Right(filePath, Len(fileName) - InStrRev(fileName, "."))


    
    fileType = "application/octet-stream"

    Set oFields = CreateObject("Scripting.Dictionary")
    With oFields
        .Add "DocumentName", fileName
        .Add "FK_Person", "xxxx"
        .Add "FK_Object", "xxxx"
        .Add "FK_FileManagerFormKey", "x"
        .Add "SystemFileType", "xxx"
        .Add "Subject", "xxxxx"
        .Add "SubjectDate", "2022-08-23"
    End With


     sBoundary = String(27, "-") & "e397af84-5525-455d-8c91-706bf0ff6b09"
          
    
    sPayLoad = ""
    For Each sName In oFields
        sPayLoad = sPayLoad & "--" & sBoundary & vbCrLf
        sPayLoad = sPayLoad & "Content-Disposition: form-data; name=""" & sName & """" & vbCrLf & vbCrLf
        sPayLoad = sPayLoad & oFields(sName) & vbCrLf
    Next

    sPayLoad = sPayLoad & "--" & sBoundary & vbCrLf
    sPayLoad = sPayLoad & "Content-Disposition: form-data; name=""DocumentContent""; " & "filename=""" & fileName & """" & vbCrLf
    sPayLoad = sPayLoad & "Content-Type: " & fileType & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf




    'Dim image
    'Set ado = CreateObject("ADODB.Stream")
    'ado.Type = 1 'binary
    'ado.Open
    'ado.LoadFromFile filePath
    'ado.Position = 0
    'image = ado.Read
    'ado.Close
        
    ' combine part, image , end
    Set ado2 = CreateObject("ADODB.Stream")
    ado2.Open
    ado2.Position = 0
    ado2.Type = 1 ' binary
    ado2.Write ToBytes(sPayLoad)
    'ado2.Write image
    ado2.Write ReadBinary(filePath)
    ado2.Write ToBytes(vbCrLf & "--" & sBoundary & "--" & vbCrLf)
    ado2.Position = 0


    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "POST", url_add, False
        .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & sBoundary
        .SetRequestHeader "api-version", "v1"
        .SetRequestHeader "Authorization", "Basic "   _
            Base64Encode(authUser   ":"   authPass)
        .Send (ado2.Read())
        
        Debug.Print .ResponseText
        MsgBox .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


Private Function ReadBinary(strFilePath As String)
    
    Dim ado As Object, bytFile
    Set ado = CreateObject("ADODB.Stream")
    ado.Type = 1
    ado.Open
    ado.LoadFromFile strFilePath

    bytFile = ado.Read
    ado.Close

    ReadBinary = bytFile

    Set ado = Nothing


End Function

CodePudding user response：

I found the mistake:

wrong:

sPayLoad = sPayLoad & "Content-Type: " & fileType & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf

correct:

sPayLoad = sPayLoad & "Content-Type: " & fileType & vbCrLf & vbCrLf