VBA Code Save in Local and Upload to Sharepoint

Question

I’m trying to generate a code that will allow me to save my activeworkbook in my local PC path and then upload that same “.xlsm” file into sharepoint. I’ve been trying for hours with no luck. The code I have will tell me that the upload was successful but the file is not actually uploaded into SharePoint. It is only saved in my local path. Please find my code below, any suggestions?

This is the breakdown so far:

Sub SaveWorkbookToLocalAndSharePoint()
    Dim wb As Workbook
    Dim localPath As String
    Dim fileName As String
    Dim todayDate As String
    Dim tempFilePath As String
    Dim http As Object
    Dim sharePointPath As String
    Dim boundary As String
    Dim requestBody As String
    Dim fileContent As String
    Dim fileData() As Byte
    
    ' Set workbook
    Set wb = ActiveWorkbook
    
    ' Get today's date in YYYYMMDD format
    todayDate = Format(Date, "YYYYMMDD")
    
    ' Create file name
    fileName = "DepoTest_" & todayDate & ".xlsm"
    
    ' Define paths
    localPath = "C:\YourLocalFolder\" & fileName  ' Change this to your local path
    sharePointPath = "https://yourcompany.sharepoint.com/sites/yoursite/Shared%20Documents/" & fileName  ' Change this to your SharePoint path
    sharePointPath = Replace(sharePointPath, " ", "%20")
    
    ' Save to local path
    On Error GoTo SaveLocalError
    Application.DisplayAlerts = False
    wb.SaveAs Filename:=localPath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Application.DisplayAlerts = True
    
    ' Save a copy to the temporary path
    tempFilePath = Environ("TEMP") & "\" & fileName
    wb.SaveCopyAs tempFilePath
    
    ' Read the file content
    fileData = ReadBinaryFile(tempFilePath)
    
    ' Create HTTP request to upload file to SharePoint
    boundary = "----WebKitFormBoundary" & Format(Timer, "0")
    requestBody = "--" & boundary & vbCrLf & _
                  "Content-Disposition: form-data; name=""file""; filename=""" & fileName & """" & vbCrLf & _
                  "Content-Type: application/vnd.ms-excel.sheet.macroEnabled.12" & vbCrLf & vbCrLf & _
                  StrConv(fileData, vbUnicode) & vbCrLf & _
                  "--" & boundary & "--"
    
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.Open "POST", sharePointPath, False
    http.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & boundary
    http.Send requestBody
    
    If http.Status = 200 Or http.Status = 201 Then
        MsgBox "Workbook saved locally and to SharePoint successfully!"
    Else
        MsgBox "Failed to upload to SharePoint. Status: " & http.Status & " " & http.StatusText
    End If
    
    ' Delete the temporary file
    On Error Resume Next
    Kill tempFilePath
    On Error GoTo 0
    
    Exit Sub

SaveLocalError:
    Application.DisplayAlerts = True
    MsgBox "An error occurred while saving the workbook to the local path: " & Err.Description
    Exit Sub
End Sub

Function ReadBinaryFile(filePath As String) As Byte()
    Dim fileNumber As Integer
    Dim fileLength As Long
    Dim fileData() As Byte
    
    fileNumber = FreeFile
    Open filePath For Binary As #fileNumber
    fileLength = LOF(fileNumber)
    ReDim fileData(1 To fileLength)
    Get #fileNumber, , fileData
    Close #fileNumber
    
    ReadBinaryFile = fileData
End Function

Answer 1

Thanks for replying. Seems like my issue was related to OneDrive/Sharepoint. So, as an alternative solutions which I’m not sure if it’s the best but it worked for me, I ended up mapping the Sharepoint/OneDrive location as a network drive, and then I was able to save directly to the network drive with the code below. I hope it helps everyone else.

Sub SaveWorkbookToMappedDrive()
Dim wb As Workbook
Dim networkPath As String
Dim fileName As String
Dim todayDate As String

' Set workbook
Set wb = ThisWorkbook

' Get today's date in YYYYMMDD format
todayDate = Format(Date, "YYYYMMDD")

' Create file name
fileName = "DepoTest_" & todayDate & ".xlsm"

' Define network path
networkPath = "Z:\" & fileName  ' Change Z: to your mapped drive letter

' Save directly to the network path
On Error GoTo SaveError
Application.DisplayAlerts = False
wb.SaveAs Filename:=networkPath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
MsgBox "Workbook saved to network drive successfully!"
Exit Sub

SaveError:
    Application.DisplayAlerts = True
    MsgBox "An error occurred while saving the workbook to the network drive: " & Err.Description
    Exit Sub
End Sub