Перемещение папки "Мои документы"

[BigBoo]

Применяю скрипт: Set Create=CreateObject("Scripting.FileSystemObject")
Set WSHShell=WScript.CreateObject("WScript.Shell")

if Not Create.FolderExists("D:\Мои документы") Then
Create.CreateFolder "D:\Мои документы"
end if

On Error Resume Next

strPersonal = WshShell.SpecialFolders("MyDocuments")
Create.CopyFolder strPersonal, "D:\Мои документы"
if strPersonal <> "D:\Мои документы" Then
Create.DeleteFolder strPersonal, True
end if

WshShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Personal","D:\Мои документы","REG_EXPAND_SZ"
WshShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\My Pictures","D:\Мои документы\Мои рисунки","REG_EXPAND_SZ"
WshShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\My Music","D:\Мои документы\Моя музыка","REG_EXPAND_SZ"
WshShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\My Video","D:\Мои документы\Мои видеозаписи","REG_EXPAND_SZ"
Вопросы:
1. Почему исчезают иконки с папок "Мои рисунки", "Моя музыка", "Мои видеозаписи" (значок становится как у обычной папки)?
2. Ткнувшись по значку "Мои документы" на рабочем столе получаю ошибку (в свойствах старый адрес папки), и всё работает только после перезагрузки.
На CMD таких проблем НЕ ВОЗНИКАЕТ!

[NiOl]

Не знаком с vbs и аналогами, но
1. Вы правите реестр, его изменения надо подгрузить в оперативку. Попробуйте gpupdate, может даже с ключиком "/force" - но команда запросто может потребовать ту самую перезагрузку...
2. Кроме создания новых папок нужно отслеживать и как минимум за файликом "Desktop.ini", а если используется режим с веб-расширениями, то там еще появляется html-ка с расширением кажется ".ht" (уже точно не помню, баловался с этим еще под 98й).

[BigBoo]

С 1-ым вопросом разобрался, но возник другой. Оказывается иконки исчезают, так как при копировании снимаются атрибуты с папок. А это не есть хорошо. Можно конечно заново установить их скриптом, но как быть, исли в "Моих документах" есть ещё папки со значками кроме "Мои рисунки", "Моя музыка", "Мои видеозаписи" . Получается, будет нужен скрипт, сканирующий имена папкок, их аттрибуты и высставляющий эти аттрибуты у папок созданных. Кстати интересно, что у скопированных файлов в папках аттрибуты сохраняются, в том числе у "Desktop.ini".

Можно ли с этими злосчастными аттрибутами разобраться как-то попроще, чем писать ещё один скрипт?

По поводу 2-го вопроса: Попробуйте gpupdate » не помогает.

[OSArev]

Прочитай в справке о VBS про Attributes

[BigBoo]

Вот набросал такой скрипт по поводу атрибутов: Set Create=CreateObject("Scripting.FileSystemObject")
Set WSHShell=WScript.CreateObject("WScript.Shell")

ToFolder = "D:\Мои документы"
strPersonal = WshShell.SpecialFolders("MyDocuments")
Set f=Create.GetFolder(strPersonal)
Create.CreateFolder(ToFolder)

For Each a in f.Subfolders
a.Copy(ToFolder & "\" & a.name)
Create.GetFolder(ToFolder & "\" & a.name).Attributes=Create.GetFolder(a).Attributes
Next

For Each a in f.Files
a.Copy(ToFolder & "\" & a.name)
Next
Как сделать так чтобы скрипт менял атрибуты не только у вложенных папок, так скажем первого уровня, но у ВСЕХ папок не зависимо от глубины вложения?

[BigBoo]

Вроде разобрался. Готовый скрипт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
Теперь остался вопрос №2.

[BigBoo]

По поводу 2-го вопроса - помогает перезапуск Explorer. Но очень раздражает, что при этом происходит сброс положения иконок рабочего стола. Интересно, существует ли способ его перезапуска без сброса положений значков?

[nsky]

2BigBoo, по поводу второго вопроса о переносе Personal.

Править надо в двух местах: ...\User Shell Folders (REG_EXPAND_SZ) и ...\Shell Folders (REG_SZ)...

Я это делаю на T12 (T13) и перезагрузка, соответственно, вовсе не нужна...
А если делать после логона, то достаточно перелогиниться или "правый клик" на рабочем столе и "обновить".

[BigBoo]

Править надо в двух местах: » Во 2-ом месте значение появляется автоматически.
на T12 (T13) и перезагрузка, соответственно, вовсе не нужна » Да, конечно. Имеется ввиду применение скрипта на "живой системе".

достаточно перелогиниться или "правый клик" на рабочем столе и "обновить" » Оказывается недостаточно, только перезапуск Explorer или перезагрузка. Отчего и вопрос.

[nsky]

Очевидно Explorer при запуске:
- обновляет ветку User Folders на основе Shell User Folders. Кстати, не всю.
- инициализирует рабочий стол.

Если выполнить за него часть работы, т.е. самому обновить обе ветки, то можно пробовать
обновить среду. Увы, пробовал в свое время
nircmd sysrefresh

Не срабатыватет.

Остается "автоматический перезапуск Explorer в случае ошибки"
HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoRestartShell
и
kill explorer

Либо просто
logoff