Upload file to file.io using POST method - excel

Question

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/

Answer 1

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