Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Uploading a PDF to SharePoint REST API using an ADODB stream #485

Open
TK-99 opened this issue Jan 17, 2023 · 1 comment
Open

Uploading a PDF to SharePoint REST API using an ADODB stream #485

TK-99 opened this issue Jan 17, 2023 · 1 comment

Comments

@TK-99
Copy link

TK-99 commented Jan 17, 2023

For anyone interested, I have managed to successfully upload PDFs to to SharePoint REST API and now the Microsoft Graph API using an ADODB stream to provide a binary object
(I haven't sorted downloading PDFs yet as I haven't needed it)

Please excuse my crappy coding - I'm sure it could be improved - I'm far from being an expert

These are some of the posts on issues here on VBA-Web and other places I have used:

VBA-Web Issues #117, #449, #453 https://github.com/VBA-tools/VBA-Web/pull/453#issue-864756726 ,#456 (closed)

https://stackoverflow.com/questions/62165095/vba-send-file-in-binary-code-to-api-via-post-method

The details of the SharePoint REST API post request are found here:

https://learn.microsoft.com/en-us/sharepoint/dev/sp-add-ins/working-with-folders-and-files-with-rest

The critical part is creating the request body:

' 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
    part = "--" & boundary & vbCrLf
    part = part & "Content-Disposition: form-data; name=""file""; filename=""" & FILENAME & """" & vbCrLf
    part = part & "Content-Type: application/pdf" & vbCrLf & vbCrLf

    ' read file into pdfBinary
    Dim pdfBinary
    Dim ado As New ADODB.Stream
    ado.Type = 1 'binary
    ado.Open
    ado.LoadFromFile FILEPATH
    ado.Position = 0
    pdfBinary = ado.Read
    ado.Close

    ' combine part, pdfBinary , end
    ado.Open
    ado.Position = 0
    ado.Type = 1 ' binary
    ado.Write ToBytes(part)
    ado.Write pdfBinary
    ado.Write ToBytes(vbCrLf & "--" & boundary & "---")
    ado.Position = 0

    '// Other parts of the header go here
    '.
    '.

    
    Request.Body = ado
    Request.ContentLength = ado.Size     
    

This is the function used in the above snippet:

'// function to turn string into Bytes - 
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 

I needed to add an extra check in the VBA-Web WebRequest.GetBody property to allow the ADODB stream object through:

Public Property Get Body() As Variant
    If Not VBA.IsEmpty(web_pBody) Then
        If VBA.VarType(web_pBody) = vbString Then
            Body = web_pBody
        
        '//added to allow an object to be passed as request body eg ADODB stream
        ElseIf VBA.VarType(web_pBody) = vbObject Then
            If TypeOf web_pBody Is ADODB.Stream Then
                 Set Body = web_pBody
            End If


        ElseIf IsEmpty(web_pConvertedBody) Then 
            ' Convert body and cache
            Body = WebHelpers.ConvertToFormat(web_pBody, Me.RequestFormat, Me.CustomRequestFormat)
            web_pConvertedBody = Body
       
        Else
            Body = web_pConvertedBody
        End If
    End If
End Property

I've used the same code to upload to Sharepoint Online via the Microsoft Graph API (but with different headers)
https://learn.microsoft.com/en-us/graph/api/driveitem-put-content?view=graph-rest-1.0&tabs=http

@Jamesdindin
Copy link

test

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

2 participants