Investigate file upload

[timhall]

File upload may be possible with the library as-is, but I've never tested it.

• [ ] Add a test case
• [ ] Add documentation
• [ ] Verify/update VBA-Web to get it working

[PioPio2]

Hi Tim,

I have found this link for sending email and relevant attachments via GMail It is written in Google App Scripts and I hope it is useful to develop the correspondent sample in VBA-Web for the same functionality.

[PioPio2]

Hi Tim, Did you have the chance to look into this ? I tried a number of time but I am too inexperienced for that.

[timhall]

@RRanjanM has a nice fix in #316. Getting warmer on this, sorry @PioPio2 I just haven't had a real-world use case to give this a good go on.

[timhall]

@struQture Also has a good fix in #309 should have enough to work on this soon.

[ghost]

Hi, we are in a project that requires to upload any files. Would it be possible to implement or add examples to upload files in binary format?

[allanbowe]

Multi-part file upload, eg CSV + binary (the excel file itself) would be really useful for a project of ours! Any tips? Can we contribute?

[Amertz08]

+1 on this. Use case would be to export range as CSV and then PUT to AWS s3.

[Amertz08]

So the example on #309 does not work for Mac as the curl string that is generated uses single quotes and thus if you use single quotes in your request body the curl string generated is invalid. See 'payload' 'example.csv' should be "payload" "example.csv"

curl -i \
    --connect-timeout 5 \
    --max-time 15 \
    --location \
    -H 'Connection: keep-alive' \
    -H 'Accept-Encoding: gzip, deflate' \
    -H 'User-Agent: VBA-Web v4.1.6 (https://github.com/VBA-tools/VBA-Web)' \
    -H 'Accept: */*' \
    -H 'Content-Type: multipart/form-data; boundary=--------------------------fygOzLJvWtag^gvn#8UyNC^N' \
    -H 'Content-Length: 240' \
    -X PUT -d '----------------------------fygOzLJvWtag^gvn#8UyNC^N
Content-Disposition: form-data; name='payload'; filename='example.csv'
Content-Type: text/csv

test@example.com,
test2@example.com
----------------------------fygOzLJvWtag^gvn#8UyNC^N--
' 'http://localhost:5000'

So double quotes must be used in your VBA code in order to generate quotes. As far as all the headers go I was simply replicating how Postman creates a request. Tested this against a simply Flask app.

[laliendre]

surfing on web I have found this code and its work.

Sub Test() pvPostFile "PutHereYourURL", "PutHereYourDocumentFullPath" End Sub

`Private Function pvPostFile(sUrl As String, sFileName As String, Optional ByVal bAsync As Boolean) As String Const STR_BOUNDARY As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113" Dim nFile As Integer Dim baBuffer() As Byte Dim sPostData As String

'--- read file
nFile = FreeFile
Open sFileName For Binary Access Read As nFile
If LOF(nFile) > 0 Then
    ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
    Get nFile, , baBuffer
    sPostData = StrConv(baBuffer, vbUnicode)
End If
Close nFile
'--- prepare body
sPostData = "--" & STR_BOUNDARY & vbCrLf & _
    "Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
    "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
    sPostData & vbCrLf & _
    "--" & STR_BOUNDARY & "--"
'--- post
With CreateObject("Microsoft.XMLHTTP")
    .Open "POST", sUrl, bAsync
    .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
    .Send pvToByteArray(sPostData)
    If Not bAsync Then
        pvPostFile = .ResponseText
    End If
End With

End Function`

Private Function pvToByteArray(sText As String) As Byte() pvToByteArray = StrConv(sText, vbFromUnicode) End Function

[caramdache]

surfing on web I have found this code and its work.

Reposting with proper formatting. This does indeed work perfectly.

Sub Test()
    pvPostFile "PutHereYourURL", "PutHereYourDocumentFullPath"
End Sub

Private Function pvPostFile(sUrl As String, sFileName As String, Optional ByVal bAsync As Boolean) As String
    Const STR_BOUNDARY  As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
    Dim nFile           As Integer
    Dim baBuffer()      As Byte
    Dim sPostData       As String

    '--- read file
    nFile = FreeFile
    Open sFileName For Binary Access Read As nFile
    If LOF(nFile) > 0 Then
        ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
        Get nFile, , baBuffer
        sPostData = StrConv(baBuffer, vbUnicode)
    End If
    Close nFile

    '--- prepare body
    sPostData = "--" & STR_BOUNDARY & vbCrLf & _
        "Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
        "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
        sPostData & vbCrLf & _
        "--" & STR_BOUNDARY & "--"

    '--- post
    With CreateObject("Microsoft.XMLHTTP")
        .Open "POST", sUrl, bAsync
        .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
        .Send pvToByteArray(sPostData)
        If Not bAsync Then
            pvPostFile = .ResponseText
        End If
    End With
End Function

Private Function pvToByteArray(sText As String) As Byte()
    pvToByteArray = StrConv(sText, vbFromUnicode)
End Function

[caramdache]

Since I need to post multiple files in a single request, I ended up using this code instead. It's been adapted from https://stackoverflow.com/a/59096719/2893408.

' Class to post arbitrary File and Form data from vbscript using multipart/form-data
'
' Usage:
'
' Set oPost = new PostMultipartForm
' oPost.AddField "FIELDNAME", "FIELDVALUE"
' oPost.AddFile "FIELDNAME", "FILENAME", "FILEPATH"
' returnvalue = oPost.SendReq(URL)
' HTTPStatus = oPost.Status
'
'For example
' Set oPost = new PostMultipartForm
' oPost.AddField "testfield1", "testvalue1"
' oPost.AddField "testfield2", "testvalue2"
' oPost.AddFile "testwavfile", "testsound.wav", "C:\temp\MyTestSound.wav"
' oPost.AddFile "testpdffile", "testdoc.pdf", "C:\temp\MyTest.pdf"
' sReturn = oPost.SendReq("http://MyWebSite/MyPostHandler.asp")
' sHTTPStatus = oPost.Status

Option Explicit

Private MULTIPART_BOUNDARY_BASE As String
Private MULTIPART_BOUNDARY As String

Private oStream

Public Status

Private Declare Function CoCreateGuid Lib "ole32" (ByRef GUID As Byte) As Long
Private Function GenerateGUID() As String
    Dim ID(0 To 15) As Byte
    Dim N As Long
    Dim GUID As String
    Dim Res As Long
    Res = CoCreateGuid(ID(0))

    For N = 0 To 15
        GUID = GUID & IIf(ID(N) < 16, "0", "") & Hex$(ID(N))
        If Len(GUID) = 8 Or Len(GUID) = 13 Or Len(GUID) = 18 Or Len(GUID) = 23 Then
            GUID = GUID & "-"
        End If
    Next N
    GenerateGUID = GUID
End Function

Private Sub Class_Initialize()
    MULTIPART_BOUNDARY_BASE = String(6, "-") & GenerateGUID()
    MULTIPART_BOUNDARY = "--" & MULTIPART_BOUNDARY_BASE

    ' To combine Text and Binary file data, an ADODB Stream is used.
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Mode = 3
    oStream.Charset = "Windows-1252"
    oStream.Open
End Sub

Private Sub Class_Terminate()
    oStream.Close
End Sub

Public Sub AddField(sField, sValue)
    oStream.WriteText MULTIPART_BOUNDARY & vbCrLf _
        & "Content-Disposition: form-data; name=""" & sField & """;" & vbCrLf & vbCrLf _
        & sValue & vbCrLf
End Sub

Public Sub AddFile(sFieldName, sFileName, sFilePath)
    Dim oByteArray

    ' ADODB stream object used to read binary file
    With CreateObject("ADODB.Stream")
        .Type = 1
        .Mode = 3
        .Open
        .LoadFromFile sFilePath
        oByteArray = .Read
    End With

    'write binary data into output stream
    With oStream
        .WriteText MULTIPART_BOUNDARY & vbCrLf
        .WriteText "Content-Disposition: form-data; name=""" & sFieldName & """; filename=""" & sFileName & """" & vbCrLf
        .WriteText "Content-Type: ""application/octet-stream""" & vbCrLf & vbCrLf
        .Position = 0
        .Type = 1
        .Position = .Size
        .Write oByteArray
        .Position = 0
        .Type = 2
        .Position = .Size
        .WriteText vbCrLf
    End With
End Sub

Public Function SendReq(sURL)
    Dim oXmlHttp, bytData

    'Add end boundary and read as byte array
    oStream.WriteText MULTIPART_BOUNDARY & "--"
    oStream.Position = 0
    oStream.Type = 1
    bytData = oStream.Read

    On Error Resume Next

    Set oXmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
    ' Set oXmlHttp = CreateObject("Microsoft.XMLHTTP")
    oXmlHttp.SetTimeouts 0, 60000, 300000, 300000
    oXmlHttp.Open "POST", sURL, False
    oXmlHttp.SetRequestHeader "Content-type", "multipart/form-data; boundary=" & MULTIPART_BOUNDARY_BASE

    oXmlHttp.Send bytData
    ' oXmlHttp.Send StrConv(bytData, vbFromUnicode)

    If Err.Number <> 0 Then
        Status = Err.Description & " (" & Err.Number & ")"
    Else
        Status = oXmlHttp.StatusText & " (" & oXmlHttp.Status & ")"
    End If
    If oXmlHttp.Status = "200" Then SendReq = oXmlHttp.ResponseText

    Set oXmlHttp = Nothing
End Function