Set Create=CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")

Letter="D:\"
ToFolder = Letter & "Мои документы"
RootFold = WshShell.SpecialFolders("MyDocuments")
i=0
Dim FoldName()
Dim FoldAttrib()
Set objFolder = objShellApp.NameSpace(RootFold)
Set objItems = objFolder.Items()
Count = objItems.Count
Redim Preserve FoldName(Count)
Redim Preserve FoldAttrib(Count)

if RootFold <> ToFolder Then

if not Create.FolderExists(ToFolder) then
Create.CreateFolder(ToFolder)
end if

Set F = Create.GetFolder(RootFold)
F.Copy ToFolder

'Читаем атрибуты подкаталогов в папке-источнике
call Get_Fold (RootFold)
sub Get_Fold (strFoldName)
Set Folder = Create.GetFolder(strFoldName)

For Each SubFolder In Folder.SubFolders
s_path=SubFolder.path
FoldName(i)=cstr(SubFolder.Name)
FoldAttrib(i)=cstr(SubFolder.Attributes)
i=i+1
call Get_Fold (s_path)
Next
end sub

'Высставляем аттрибуты подкаталогов в папке назначения как в папке-источнике
call Get_ToFold (ToFolder)
sub Get_ToFold (strFoldName)
Set Folder = Create.GetFolder(strFoldName)

For Each SubFolder In Folder.SubFolders
s_path=SubFolder.path
For i=0 To Count
if SubFolder.Name=FoldName(i) then
SubFolder.Attributes=FoldAttrib(i)
end if
next
call Get_ToFold (s_path)
Next
end sub

On Error Resume Next
Create.DeleteFolder RootFold, True

WshShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Personal",ToFolder,"REG_EXPAND_SZ"
WshShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\My Pictures",ToFolder & "\Мои рисунки","REG_EXPAND_SZ"
WshShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\My Music",ToFolder & "\Моя музыка","REG_EXPAND_SZ"
WshShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\My Video",ToFolder & "\Мои видеозаписи","REG_EXPAND_SZ"

'Запрос о перезагрузке
strComputer = "."
strNamespace = "Root\CIMV2"
strClass = "Win32_OperatingSystem"
Set objClass = GetObject("WinMgmts:{(Shutdown,RemoteShutdown)}!\\" & strComputer & "\" & strNamespace & ":" & strClass)
Set colInstances = objClass.Instances_
For Each objInstance In colInstances
iAnswer = MsgBox("Перезагрузить компьютер сейчас?", vbQuestion + vbOKCancel, "Требуется перезагрузка!")
If iAnswer = vbOK Then
objInstance.Reboot()
End if
Next
end if