excelvbasharepointautomationsharepoint-online

VBA Code Save in Local and Upload to Sharepoint


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

Solution

  • Seems my issue was related to OneDrive/SharePoint.

    As an alternative, I mapped the SharePoint/OneDrive location as a network drive. I saved to the network drive with the code below.

    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