VBA Uploading files to SharePoint using a file dialog

62 views Asked by At

I have move my backend to sharepoint and created a folder called Images. The folder exists in the documents folder. The linked string is in the form: https://webname365.sharepoint.com/sites/SECS-Department I would like to upload files to the Images folder in the Documents folder using a file dialog. https://webname365.sharepoint.com/sites/SECS-Department/Shared Documents/Images/ I have looked around and using the REST API seems to be the best method for doing this. I came across https://stackoverflow.com/questions/75285008/vba-upload-of-file-to-sharepoint-using-rest-api-download-already-implemented-in and tried to addapt it but I get Error "404 NOT FOUND" Can someone help me with this?

Private Sub uploadImage_Click()
    Dim ado As Object
    Dim ofd As Object
    Dim filePath As String
    Dim strExt As String
    Dim newFileName As String
    Dim strBackEndPath As String
    Dim i As Integer
    Dim SharePointURL As String

    strBackEndPath = CurrentDb.TableDefs("tblEquipment").Connect
    i = InStrRev(strBackEndPath, "DATABASE=") + Len("DATABASE=")
    
    SharePointURL = Mid(strBackEndPath, i, InStr(i, strBackEndPath, ";") - i) & "/Shared Documents/Images/"
    SharePointURL = Replace(Mid(strBackEndPath, i, InStr(i, strBackEndPath, ";") - i) & "/Shared Documents/Images/", " ", "%20")

    Set ofd = Application.FileDialog(3)
    ofd.AllowMultiSelect = False
    ofd.Show

    If ofd.SelectedItems.Count = 1 Then
        filePath = ofd.SelectedItems(1)
        strExt = Mid(ofd.SelectedItems(1), InStrRev(ofd.SelectedItems(1), "."))

        If strExt = ".jpeg" Then
            strExt = ".jpg"
        End If
        
        newFileName = ReplaceSpecialChars(Me.itemName.Value, "-") & "_" & ReplaceSpecialChars(Nz(Me.Model.Value, ""), "-") & strExt

        Debug.Print filePath
        Debug.Print newFileName
        Debug.Print SharePointURL
 
        Set ado = CreateObject("ADODB.Stream")
        With ado
            .Type = 1 'binary
            .Open
            .LoadFromFile filePath
            .Position = 0
        End With

        Dim client As Object
        Set client = CreateObject("MSXML2.XMLHTTP.6.0")
        With client
            .Open "POST", SharePointURL & newFileName, False
            .send ado.read
            ado.Close
            
            Debug.Print .responseText
            If .Status = 200 Then '200 = OK
                MsgBox "Upload completed successfully"
            Else
                MsgBox .Status & ": " & .StatusText
            End If
        End With
    Else
        MsgBox "Image update Cancel!"
    End If
End Sub
0

There are 0 answers