vbaposthttp-post

Upload a Picture to file.io (HTTP Post) in VBA


I am trying to upload a file with https://file.io with VBA in Excel, using their Api (https://www.file.io/#one, see below).

I've found this thread how to upload file to file.io and get link, however, I didn't know how to accurately transfer it from C# to VBA.

The syntax on File.io is:

$ curl -F "file=@test.txt" https://file.io
{"success":true,"key":"2ojE41","link":"https://file.io/2ojE41","expiry":"14 days"}
$ curl https://file.io/2ojE41 
This is a test
$ curl https://file.io/2ojE41
{"success":false,"error":404,"message":"Not Found"}

My current code looks as following:

Set objhttp = CreateObject("MSXML2.ServerXMLHTTP")
URL = "https://file.io"
objhttp.Open "post", URL, False
objhttp.setRequestHeader "Content-type", "application/json" 
objhttp.Send ("file=@C:/Users/me/Downloads/image.jpg")
Debug.Print objhttp.responsetext

My Responsetext says:

{"success":false,"error":400,"message":"Trouble uploading file"}

I'm not even sure about the "@" in the Path or if there's normally a standard folder to be used, etc. Many thanks in advance! All help is appreciated.


Solution

  • Steps to post multipart/form-data using XmlHttp VBA

    1. Use Chrome/Firefox/Fiddler to watch HTTP request.
    2. First manually upload the file and see all request & response which browser does
      (especially xhr, document request with status code 200)
    3. Pass the cookies, parameters in the post request

    I have used chrome browser in this case and the image below shows the parameter which the browser sends along in the request.

    enter image description here


     Sub UploadFilesUsingVBA()
         'this proc will upload below files to https://file.io/
              '  png, jpg, txt
    
            Dim fileFullPath As String
            fileFullPath = "C:\Users\santosh\Desktop\abcd.txt"
    
            POST_multipart_form_data fileFullPath
        End Sub
    

    Confirmation message in case of successful file upload enter image description here


    Private Function GetGUID() As String
        ' Generate uuid version 4 using VBA
        GetGUID = WorksheetFunction.Concat(WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(0, 4294967295#), 8), "-", WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(0, 65535), 4), "-", WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(16384, 20479), 4), "-", WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(32768, 49151), 4), "-", WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(0, 65535), 4), WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(0, 4294967295#), 8))
    
    End Function
    
    Private Function GetFileSize(fileFullPath As String) As Long
    
        Dim lngFSize As Long, lngDSize As Long
        Dim oFO As Object, OFS As Object
    
        lngFSize = 0
        Set OFS = CreateObject("Scripting.FileSystemObject")
    
        If OFS.FileExists(fileFullPath) Then
            Set oFO = OFS.getFile(fileFullPath)
            GetFileSize = oFO.Size
        Else
            GetFileSize = 0
        End If
    
        Set oFO = Nothing
        Set OFS = Nothing
    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
    
    
    Private Function toArray(str)
        Dim ado As Object
         Set ado = CreateObject("ADODB.Stream")
         ado.Type = 2
         ado.Charset = "_autodetect"
         ado.Open
         ado.WriteText (str)
         ado.Position = 0
         ado.Type = 1
         toArray = ado.Read()
         Set ado = Nothing
    End Function
    
    
    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
    
        fileName = Right(filePath, Len(filePath) - InStrRev(filePath, "\"))
        fileExtn = Right(filePath, Len(fileName) - InStrRev(fileName, "."))
    
        Select Case fileExtn
         Case "png"
            fileType = "image/png"
         Case "jpg"
            fileType = "image/jpeg"
         Case "txt"
            fileType = "text/plain"
        End Select
    
        Set oFields = CreateObject("Scripting.Dictionary")
        With oFields
            .Add "qquuid", GetGUID
            .Add "qqtotalfilesize", GetFileSize(filePath)
        End With
    
        sBoundary = String(27, "-") & "7e234f1f1d0654"
        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=""file""; " & "filename=""" & fileName & """" & vbCrLf
        sPayLoad = sPayLoad & "Content-Type: " & fileType & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf
    
    
    
         sPayLoad = sPayLoad & "--" & sBoundary & "--"
    
    
          Set ado = CreateObject("ADODB.Stream")
          ado.Type = 1
          ado.Open
          ado.Write toArray(sPayLoad)
          ado.Write ReadBinary(filePath)
          ado.Position = 0
    
        With CreateObject("MSXML2.ServerXMLHTTP")
            .Open "POST", "https://file.io", False
            .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & sBoundary
            .Send (ado.Read())
            MsgBox .responseText
        End With
    
    End Sub
    

    Links which helped to answer this question
    1. https://stackoverflow.com/a/43266809/2227085
    2. https://wqweto.wordpress.com/