Код:
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder("d:\1\FOX\")'Копируемая папка
ImputName2 = InputBox ("Введите имя для создания папки архива")
Set enddir = FSO.CreateFolder ("D:\times\" & ImputName2)
Set NewFolder = enddir.SubFolders.Add("FOX")'Создаём подпапку
Folder.Copy enddir & "\FOX"'Копируем в подпапку
Попробуйте такой вариант.
