Excel VBA .saveas premission denied with onedrive - excel

Question

I've created a macro to get data from active workbook, copy it into a new one and save new file. Whole code worked perfect until I changed Office to 365 with Onedrive on my computer.
When I run this macro, I get error 1004: Premission denied in macro below
Sub create_new()
Dim SheetI As Worksheet
Dim SheetO As Worksheet
Dim BookO As Workbook
Dim BookI As Workbook
Dim row As Long
Dim i As Long
Dim dict As Object
Dim path As String
Dim brng As Range
Dim found As Boolean
path = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\path\"
If Len(Dir(path, vbDirectory)) = 0 Then MkDir path
path = path & _
Format(Date, "ddmmmyyyy") & ".xlsx"
If Dir(path) <> "" Then Kill path
Set BookI = ThisWorkbook
Set BookO = Workbooks.Add
With BookO
BookO.Sheets.Add.Name = "Name"
Set SheetO = BookO.Sheets("Name")
SheetO.Cells(1, 1).Value = "1"
SheetO.Cells(1, 2).Value = "2"
SheetO.Cells(1, 3).Value = "3"
SheetO.Columns("A:H").AutoFit
SheetO.Range("a1:h1").Font.Bold = True
Application.DisplayAlerts = False
.SaveAs path
Application.DisplayAlerts = True
End With
Set dict = SubTotals(BookI)
For Each SheetI In BookI.Sheets
If SheetI.Name <> "Dane" Then
For row = 10 To SheetI.Cells(Rows.Count, 1).End(xlUp).row Step 1
If i <= row Then
If SheetI.Cells(row, 2).Value = "Oprysk" Then
If Not found Then found = True
i = row
If SheetI.Cells(row, 2).MergeCells Then i = row + SheetI.Cells(row, 2).MergeArea.Rows.Count - 1
With BookO
Range(SheetI.Cells(row, 1), SheetI.Cells(i, 1)).Copy
SheetO.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range(SheetI.Cells(row, 5), SheetI.Cells(i, 8)).Copy
SheetO.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
SheetI.Cells(2, 2).Copy
SheetO.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
SheetI.Cells(3, 5).Copy
SheetO.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
SheetO.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = SearchDict(dict, SheetO.Cells(Rows.Count, 3).End(xlUp).Value)
If i <> row Then
For l = 1 To 8 Step 1
If l <> 6 And l <> 7 Then
Application.DisplayAlerts = False
Range(SheetO.Cells(Rows.Count, l).End(xlUp), SheetO.Cells(Rows.Count, l).End(xlUp).Offset(i - row, 0)).Merge
Application.DisplayAlerts = True
End If
Next l
End If
End With
End If
End If
Next row
End If
Next SheetI
If found Then
Set brng = Range(SheetO.Cells(1, 1), SheetO.Cells(Rows.Count, 6).End(xlUp).Offset(0, 2))
With BookO
brng.BorderAround xlContinuous, xlThin
brng.Borders(xlInsideHorizontal).LineStyle = xlContinuous
brng.Borders(xlInsideVertical).LineStyle = xlContinuous
Application.DisplayAlerts = False
.SaveAs path
Application.DisplayAlerts = True
End With
MsgBox "File saved in path: " & path
Else
With BookO
Application.DisplayAlerts = False
BookO.Close
Application.DisplayAlerts = True
End With
Kill path
MsgBox "Data not found"
End If
End Sub
So basicly I check here if the path and file exists. If not, its created. I save the new workbook for the first time when its formated but before data is copied. Secondly its saved when the data is copied and this second attempt to save workbook fails with error above. Why I was able to overwrite this workbook when I didnt use Onedrive and now, when I do it shows me the error?