title: Excel VBA .saveas premission denied with onedrive
body: <p>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</p>
  <pre><code>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(&quot;WScript.Shell&quot;).SpecialFolders(&quot;MyDocuments&quot;) &amp; &quot;\path\&quot;
      If Len(Dir(path, vbDirectory)) = 0 Then MkDir path
      path = path &amp; _
          Format(Date, &quot;ddmmmyyyy&quot;) &amp; &quot;.xlsx&quot;
      If Dir(path) &lt;&gt; &quot;&quot; Then Kill path
      Set BookI = ThisWorkbook
      Set BookO = Workbooks.Add
      With BookO
          BookO.Sheets.Add.Name = &quot;Name&quot;
          Set SheetO = BookO.Sheets(&quot;Name&quot;)
          SheetO.Cells(1, 1).Value = &quot;1&quot;
          SheetO.Cells(1, 2).Value = &quot;2&quot;
          SheetO.Cells(1, 3).Value = &quot;3&quot;
          SheetO.Columns(&quot;A:H&quot;).AutoFit
          SheetO.Range(&quot;a1:h1&quot;).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 &lt;&gt; &quot;Dane&quot; Then
              For row = 10 To SheetI.Cells(Rows.Count, 1).End(xlUp).row Step 1
                  If i &lt;= row Then
                      If SheetI.Cells(row, 2).Value = &quot;Oprysk&quot; 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 &lt;&gt; row Then
                                  For l = 1 To 8 Step 1
                                      If l &lt;&gt; 6 And l &lt;&gt; 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 &quot;File saved in path: &quot; &amp; path
      Else
          With BookO
              Application.DisplayAlerts = False
              BookO.Close
              Application.DisplayAlerts = True
          End With
          Kill path
          MsgBox &quot;Data not found&quot;
      End If
          
  End Sub 
  </code></pre>
  <p>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?</p>