VBA to Save a New File to One Drive

[BMil8]

Hello,
I've found similar posts on here similar to my issue, but I've been unable to get any of the proposed solutions to work. I have a workbook that I filter and then copy to a brand new workbook. I'm trying to save it to a location on One Drive. It's strange because most of the time it fails, but every once in a while (5% of the time) without changing anything, it completes successfully. It stops at the "ActiveWorkbook.SaveAs Path & FileName, xlOpenXMLWorkbook" line in the code. What am I doing wrong?

Sub Create()
'
' Create Macro
'

'
    Dim Path As String
    Dim FileName As String
    
    
    Range("E3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("NonSpon").Select
    ActiveSheet.Range("$A:$H").AutoFilter Field:=3, Criteria1:=Worksheets("Macro").Range("E3").Value
    Range("A1:J1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Columns("A:H").Select
    Columns("A:H").EntireColumn.AutoFit
    Range("A1").Select
    Application.CutCopyMode = False
    
    FileName = Range("J1").Value & ".xlsx"
    Path = "https://testfwt.sharepoint.com/sites/testFinance/Shared%20Documents/DNU-Invoice%20Support/Support%20Files/"
    ActiveWorkbook.SaveAs Path & FileName, xlOpenXMLWorkbook
        
    ActiveWindow.Close
    Range("A1").Select
    ActiveSheet.ShowAllData
    Sheets("Macro").Select
    Range("E4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("E3").Select
    ActiveSheet.Paste
    Range("E3").Select

    If ActiveSheet.Range("E3").Value = "" Then Exit Sub
    Call Create
    
End Sub

 

[BMil8]

Update: This seems to happen if the file already exists. There is a syncing issue that even if I delete the file first and I think it is gone, it takes a little while for it to actually register. So I guess my follow up question would be, why am I not getting a "File already exists" error? I just get a message that reads "Run-time error 1004: Method: SaveAs of object_Workbook failed. Is there a line I can add that will just save over the existing one, if it does exist?

 

[Logit]

Untested here :

Sub Create()
'
' Create Macro
'

'
    Dim Path As String
    Dim FileName As String
    Dim FileExists As Boolean
    Dim Overwrite As VbMsgBoxResult
    
    Range("E3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("NonSpon").Select
    ActiveSheet.Range("$A:$H").AutoFilter Field:=3, Criteria1:=Worksheets("Macro").Range("E3").Value
    Range("A1:J1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Columns("A:H").Select
    Columns("A:H").EntireColumn.AutoFit
    Range("A1").Select
    Application.CutCopyMode = False
    
    FileName = Range("J1").Value & ".xlsx"
    Path = "https://testfwt.sharepoint.com/sites/testFinance/Shared%20Documents/DNU-Invoice%20Support/Support%20Files/"
    
    ' Check if file exists
    FileExists = Dir(Path & FileName) <> ""
    
    ' If the file exists, prompt the user to decide
    If FileExists Then
        Overwrite = MsgBox("The file already exists. Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
        If Overwrite = vbYes Then
            ActiveWorkbook.SaveAs Path & FileName, xlOpenXMLWorkbook
        End If
    Else
        ActiveWorkbook.SaveAs Path & FileName, xlOpenXMLWorkbook
    End If
    
    ActiveWindow.Close
    Range("A1").Select
    ActiveSheet.ShowAllData
    Sheets("Macro").Select
    Range("E4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("E3").Select
    ActiveSheet.Paste
    Range("E3").Select

    If ActiveSheet.Range("E3").Value = "" Then Exit Sub
    Call Create
    
End Sub