Как предотвратить ошибку «Отказано в доступе» при попытке скопировать листы из расположения сервера (VBA)?

Question

Я относительно новичок в программировании, но постараюсь объяснить свою проблему как можно лучше.

У меня есть несколько модулей VBA, сохраненных в личной книге Excel, которые копируют лист из книги, сохраненной насервер и вставьте его в активную книгу (сохраненную на том же сервере) при нажатии назначенных кнопок на ленте.

Это прекрасно работает, пока я не попытаюсь «сохранить» в другом месте на том же сервере.Затем, нажимая на кнопки с лентой, я получаю сообщение об ошибке «Отказано в доступе», и в папке, в которую я пытаюсь сохранить файл, создается файл .tmp.

Я прикрепил приведенный ниже код.Извините, если форматирование выключено.

Любая помощь будет высоко ценится

Blockquote

Public Sub TEST()

    Dim sourceBook As Workbook
    Application.ScreenUpdating = False
    Set targetBook = ActiveWorkbook
    Set sourceBook = Workbooks.Open("\\serv01\company\TEST\TEST.xlsx")
    sourceBook.Sheets("TEST").Copy Before:=targetBook.Sheets(targetBook.Sheets.Count - 1)
    sourceBook.Close
    Application.ScreenUpdating = True
    Sheets(targetBook.Sheets.Count - 2).Select
        Range("A6:A10").Select
    Selection.insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1:A5").Select
    Selection.Delete Shift:=xlUp
    Range("A1:A5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Sheets(targetBook.Sheets.Count).Select
    Range("A1:F5").Select
    Selection.Copy
    Sheets(targetBook.Sheets.Count - 2).Select
    Range("A1:F5").Select
    ActiveSheet.Paste
    Range("C3").Value = "TEST"
    SendKeys "{ESC}"
    Range("A6").Select
End Sub