VBA .SaveAs to Sharepoint failing intermittently Error 1004

[TheCobbler]

Hi,

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

Option Explicit
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
    Next
    
    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)
    Next
                
    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
        Next
    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

 

[TheCobbler]

Hi,

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

Option Explicit
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
    Next
   
    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)
    Next
               
    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
        Next
    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

 

[WouterVP]

I had the same problem, but I've placed "On Error Resum Next" just before the "Save As" code, and that works.

 

[TheCobbler]

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

 

[TheCobbler]

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

 

[MartinS]

Which version of SharePoint are you using?

 

[TheCobbler]

Which version of SharePoint are you using?

Hi I believe: 'SharePoint in Microsoft 365 (formerly known as "SharePoint Online")' Cheers

 

[MartinS]

This will probably be due to your access token expiring. We have had major issues reading/writing from/to SharePoint Online after moving from a previous version of SharePoint where we used WebDav to mimic a file system, which doesn't work in SO.
We ended up writing a whole bunch of code using C# and Graph API to allow us to silently authenticate with Azure AD etc.
The only workaround I'm aware of is to open the SharePoint root site to generate a token, and then it should work until that token expires, but that's not a long term solution.