Search code examples
excelvbahttp-post

Upload file to file.io using POST method


I have found a link at SO that may make difference at this query Upload a Picture to file.io (HTTP Post) in VBA The code from this link

Sub UploadFilesUsingVBAORIGINAL()
     'this proc will upload below files to https://file.io/
          '  png, jpg, txt

        Dim fileFullPath As String
        fileFullPath = ThisWorkbook.Path & "\Sample.txt"

        POST_multipart_form_dataO fileFullPath
    End Sub

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_dataO(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", LCase(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())
        Debug.Print .responseText
    End With

End Sub

Anyone can try this code as the website is for free. When I run the code, I got "Success" in the immediate window and got a link to the uploaded file. This appears to have no problem but when taking the link and put it in a browser, I got 404 Page not found

I tried uploading the same file manually and it works well without any problem as for the link I got from this manual steps

Any help please?

Posted here too https://chandoo.org/forum/threads/upload-file-to-file-io-using-post-method.43925/


Solution

  • It looks to me like the final boundary is in the wrong place ie before the file content. Try

    Sub UploadToIO()
    
        Const PATH = "c:\tmp\"
        Const FILENAME = "testimage.png"
        Const CONTENT = "image/png"
        Const URL = "https://file.io"
        
        ' generate boundary
        Dim BOUNDARY, s As String, n As Integer
        For n = 1 To 16: s = s & Chr(65 + Int(Rnd * 25)): Next
        BOUNDARY = s & CDbl(Now)
        
        Dim part As String, ado As Object
        part = "--" & BOUNDARY & vbCrLf
        part = part & "Content-Disposition: form-data; name=""file""; filename=""" & FILENAME & """" & vbCrLf
        part = part & "Content-Type: " & CONTENT & vbCrLf & vbCrLf
               
        ' read file into image
        Dim image
        Set ado = CreateObject("ADODB.Stream")
        ado.Type = 1 'binary
        ado.Open
        ado.LoadFromFile PATH & FILENAME
        ado.Position = 0
        image = ado.read
        ado.Close
            
        ' combine part, image , end
        ado.Open
        ado.Position = 0
        ado.Type = 1 ' binary
        ado.Write ToBytes(part)
        ado.Write image
        ado.Write ToBytes(vbCrLf & "--" & BOUNDARY & "--")
        ado.Position = 0
        'ado.savetofile "c:\tmp\debug.bin", 2 ' overwrite
        
        ' send request
        With CreateObject("MSXML2.ServerXMLHTTP")
            .Open "POST", URL, False
            .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & BOUNDARY
            .send ado.read
            Debug.Print .responseText
        End With
    
        MsgBox "File: " & PATH & FILENAME & vbCrLf & _
               "Boundary: " & BOUNDARY, vbInformation, "Uploaded to " & URL
    
    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