Struggling with VBA .SaveAs from Desktop (365) to Sharepoint. It's failing intermittently with an "Error 1004 Document not saved." I've check the paths and they exist and receive the files when it works. I've found other documentation on this subject concerning Onedrive and Sharepoint but no firm answer on why.
I'm having the same issue across multiple vba macros stored in modules as .xlam within excel. I then call the macros using a customized entry on the ribbon.
Any help or advice is greatly appreciated!
Sub Oscar() Dim MyRange, MyRangeB, MyCell, MyCellB, WarnRng, WarnC, SkuRng, SkuCell As Range Dim Fname As Variant Dim Answer As Integer Dim OscFname, OscOneDrive As String Answer = MsgBox("You are about to run the Macro. Are you sure?", vbQuestion + vbOKCancel) If Answer = vbCancel Then Exit Sub Fname = Application.GetOpenFilename(FileFilter:="Excel Workbooks,*.*", Title:="Open the Report...", MultiSelect:=False) If Fname <> False Then Workbooks.Open Filename:=Fname End If Application.ScreenUpdating = False Sheets(1).Activate ActiveSheet.Cells(1, 1).Select Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Select Rows(ActiveCell.Row).ClearContents Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Select Rows(ActiveCell.Row).ClearContents Set MyRange = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row) For Each MyCell In MyRange If IsNumeric(MyCell) = True Then MyCell.NumberFormat = "@" '@ indicates text formatting MyCell = "0000000000000" & MyCell 'formats to 13 MyCell = Right(MyCell, 13) 'extracts the right 13 digits End If Next MyCell Set MyRangeB = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row) For Each MyCellB In MyRangeB If MyCellB.Value = "" Then MyCellB = MyCellB.Offset(, -1).Value Set WarnRng = Range("Q2:Q" & Cells(Rows.Count, "Q").End(xlUp).Row) For Each WarnC In WarnRng If WarnC = "WARNERS" Then WarnC.Offset(0, -15).Value = WarnC.Offset(, -16) Range("B1").EntireColumn.Insert Set SkuRng = Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row) For Each SkuCell In SkuRng If Not IsEmpty(SkuCell) Then SkuCell.Offset(, -1) = "_" & SkuCell End If Cells(1, 2) = "Merged SKU" ActiveSheet.Name = "Oscar Report" Application.ScreenUpdating = True OscFname = "Report%20" & Format(Now(), "DD-MM-YYYY") & ".xls" OscOneDrive = "https://XXXXXXX.XXXXXXX.com/sites/XXXXXXX/Shared%20Documents/XXXXXXX%20Reports/" ActiveWorkbook.SaveAs Filename:=OscOneDrive & OscFname, FileFormat:=xlExcel8 'Highlighted in yellow when debugging ActiveWorkbook.Close False End Sub Struggling with VBA .SaveAs from Desktop (365) to Sharepoint. It's failing intermittently with an "Error 1004 Document not saved." I've check the paths and they exist and receive the files when it works. I've found other documentation on this subject concerning Onedrive and Sharepoint but no firm answer on why.
I'm having the same issue across multiple vba macros stored in modules as .xlam within excel. I then call the macros using a customized entry on the ribbon.
Any help or advice is greatly appreciated!
Sub Oscar() Dim MyRange, MyRangeB, MyCell, MyCellB, WarnRng, WarnC, SkuRng, SkuCell As Range Dim Fname As Variant Dim Answer As Integer Dim OscFname, OscOneDrive As String Answer = MsgBox("You are about to run the Macro. Are you sure?", vbQuestion + vbOKCancel) If Answer = vbCancel Then Exit Sub Fname = Application.GetOpenFilename(FileFilter:="Excel Workbooks,*.*", Title:="Open the Report...", MultiSelect:=False) If Fname <> False Then Workbooks.Open Filename:=Fname End If Application.ScreenUpdating = False Sheets(1).Activate ActiveSheet.Cells(1, 1).Select Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Select Rows(ActiveCell.Row).ClearContents Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Select Rows(ActiveCell.Row).ClearContents Set MyRange = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row) For Each MyCell In MyRange If IsNumeric(MyCell) = True Then MyCell.NumberFormat = "@" '@ indicates text formatting MyCell = "0000000000000" & MyCell 'formats to 13 MyCell = Right(MyCell, 13) 'extracts the right 13 digits End If Next MyCell Set MyRangeB = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row) For Each MyCellB In MyRangeB If MyCellB.Value = "" Then MyCellB = MyCellB.Offset(, -1).Value Set WarnRng = Range("Q2:Q" & Cells(Rows.Count, "Q").End(xlUp).Row) For Each WarnC In WarnRng If WarnC = "WARNERS" Then WarnC.Offset(0, -15).Value = WarnC.Offset(, -16) Range("B1").EntireColumn.Insert Set SkuRng = Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row) For Each SkuCell In SkuRng If Not IsEmpty(SkuCell) Then SkuCell.Offset(, -1) = "_" & SkuCell End If Cells(1, 2) = "Merged SKU" ActiveSheet.Name = "Oscar Report" Application.ScreenUpdating = True OscFname = "Report%20" & Format(Now(), "DD-MM-YYYY") & ".xls" OscOneDrive = "https://XXXXXXX.XXXXXXX.com/sites/XXXXXXX/Shared%20Documents/XXXXXXX%20Reports/" ActiveWorkbook.SaveAs Filename:=OscOneDrive & OscFname, FileFormat:=xlExcel8 'Highlighted in yellow when debugging ActiveWorkbook.Close False End Sub Anyone using Onedrive had any experience of this? Thanks I had the same problem, but I've placed "On Error Resum Next" just before the "Save As" code, and that works. Thanks will give it a go - Maybe error handling is the way forward I had the same problem, but I've placed "On Error Resum Next" just before the "Save As" code, and that works. Have given this a go but still only works intermittently and doesn't always save the file. Seems to be even worse when I try on a colleague's machine.
Also tried DoEvents in case that would help the system catch up or wait until the save is done but still nothing.
Really struggling to identify the problem! Any other ideas? Thanks