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
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