Скопировать один файл в несколько подпапок

Question

Я пытаюсь скопировать один файл в несколько подпапок. И файл, и вложенные папки уже существуют. Я продолжаю получать сообщение об ошибке 70: во время выполнения кода отказано в разрешении.

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

И я создал все подпапки с помощью скрипта vba, поэтому я действительно озадачен ... Почему я не получил ту же ошибку в тот раз?

Это код, который у меня естьпроблема с ...

Sub LoopSubFoldersAndCopyPasteFile()

Dim fso As Object
Dim folder As Object
Dim subfolders As Object
Dim MyFile As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.Getfolder("\\SRV-FIL01\Users$\CVS\Desktop\Nye Protokoller\2013\")
Set subfolders = folder.subfolders


For Each subfolders In subfolders

    Set MyFile = fso.Getfile("\\SRV-FIL01\Users$\CVS\Desktop\Protokoller\TyskeProtokoller_2013.xlsx")
    SetAttr MyFile, vbNormal
    SetAttr subfolders, vbNormal

    fso.CopyFile MyFile, subfolders

Next

'Release memory
Set fso = Nothing
Set folder = Nothing
Set subfolder = Nothing

End Sub

Я ожидал, что MyFile будет скопирован во все подпапки, но вместо этого я получил ошибку времени выполнения 70: В доступе отказано

Answer 1

Возможно, это решит вашу проблему

Sub LoopSubFoldersAndCopyPasteFile()

Dim fso As Object
Dim folder As Object
Dim subfolders As Object
Dim MyFile As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("\\SRV-FIL01\Users$\CVS\Desktop\Nye Protokoller\2013\")
'Set subfolders = folder.subfolders

Dim fld As obejct
For Each fld In folder.subfolders

    Set MyFile = fso.GetFile("\\SRV-FIL01\Users$\CVS\Desktop\Protokoller\TyskeProtokoller_2013.xlsx")
    SetAttr MyFile, vbNormal
    SetAttr fld, vbNormal

    fso.CopyFile MyFile.Path, fld.Path & "\" & MyFile.Name

Next

End Sub