[deepred]

vdereberya,

Так условиями задачи не предусматривается ни подключение, ни расшаривание папок на
удаленном ПК, то предполагаю что папка доступна как сетевой диск и решение будет такое:

Код:

Dim input, StrDSTFolder, StrLoctFolder

    ArrSubFolders = Array("Folder1", "Folder2", "Folder3", "Folder4", "Folder5")
    ' Перечень вложенных папок
    Input = InputBox("Введите имя папки")

    StrDSTFolder   =  "F:\" ' Некая папка на сервере
    StrLoctFolder  =  StrDSTFolder & Input & "\"

    Set objShellApp = CreateObject("Shell.Application")
    Set objFolder = objShellApp.NameSpace(StrDSTFolder)
        objFolder.NewFolder(Input)

    Wscript.Sleep 3000

    Set objSubFolder = objShellApp.NameSpace(StrLoctFolder)
        For Each StrSubFolder In ArrSubFolders
            objSubFolder.NewFolder(StrSubFolder)
        Next

Wscript.Quit 0

[vdereberya]

deepred огромное спасибо за код!!! Хочу только уточнить как бить если серверная папка не подключена как сетевой диск, а просто доступна по сети (напр. \\server\ user\) Чтение/запись в папку для пользователей - разрешено.

[vitaliyboch]

так нужно так и указать:

Код:

StrDSTFolder   =  "\\Server\Folder\" ' Некая папка на сервере

а запускать с компьютеров

[vdereberya]

Гениально! Огромное спасибо! А для того что бы в директории например «Folder1» создать еще подуровень, что нужно?

[deepred]

vdereberya,

приведенный код уже содержал ответ на Ваш вопрос, но тем не менее:

Код:

Dim input, StrDSTFolder, StrLoctFolder, StrDp2LoctFolder

    ArrSubFolders = Array("Folder1", "Folder2", "Folder3", "Folder4", "Folder5")
    Input = InputBox("Введите имя папки")

    StrDSTFolder   =  "F:\"
    StrLoctFolder  =  StrDSTFolder & Input & "\"

    Set objShellApp = CreateObject("Shell.Application")
    Set objFolder = objShellApp.NameSpace(StrDSTFolder)
        objFolder.NewFolder(Input)

    Wscript.Sleep 3000

    Set objSubFolder = objShellApp.NameSpace(StrLoctFolder)
        For Each StrSubFolder In ArrSubFolders
            objSubFolder.NewFolder(StrSubFolder)

            IF ArrSubFolders(0) = StrSubFolder Then
              StrDp2LoctFolder    =  StrLoctFolder & ArrSubFolders(0) & "\"
              Set objSubDp2Folder = objShellApp.NameSpace(StrDp2LoctFolder)
              objSubDp2Folder.NewFolder("Dp2LoctFolder") ' В Folder1 вкладываем один каталог
            End if

        Next

Wscript.Echo "D O N E"
Wscript.Quit 0

[vdereberya]

Спасибо!

[vdereberya]

а как решить: при нажатии кнопки «Отмена» пишет «ошибка: Требуется объект objSubFolder» ?

[deepred]

vdereberya,

Нужно подредактировать начало сценария:

Код:

On Error resume Next
    Dim input, StrDSTFolder, StrLoctFolder, StrDp2LoctFolder
    ArrSubFolders = Array("Folder1", "Folder2", "Folder3", "Folder4", "Folder5")
    Input = InputBox("Введите имя папки")
    
    If IsEmpty(input) Then
       WScript.Quit 0
    End if

.........

[vdereberya]

Даже не знаю как благодарить! Огромное спасибо!