VBS/WSH/JS - Перемещение папки "Мои документы"

[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-го вопроса:
Цитата NiOl:



Попробуйте gpupdate

VBS/WSH/JS - Перемещение папки "Мои документы"

не помогает.

[OSArev]

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

[OSArev]

Вот набросал такой скрипт по поводу атрибутов:

Код:

Код: Выделить всё

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]

Цитата nsky:



Править надо в двух местах:

VBS/WSH/JS - Перемещение папки "Мои документы"

Во 2-ом месте значение появляется автоматически.


Цитата nsky:



на T12 (T13) и перезагрузка, соответственно, вовсе не нужна

VBS/WSH/JS - Перемещение папки "Мои документы"

Да, конечно. Имеется ввиду применение скрипта на "живой системе".




Цитата nsky:



достаточно перелогиниться или "правый клик" на рабочем столе и "обновить"

VBS/WSH/JS - Перемещение папки "Мои документы"

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

[nsky]

Очевидно Explorer при запуске:

- обновляет ветку User Folders на основе Shell User Folders. Кстати, не всю.

- инициализирует рабочий стол.



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

обновить среду. Увы, пробовал в свое время

nircmd sysrefresh



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



Остается "автоматический перезапуск Explorer в случае ошибки"

HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\AutoRestartShell

и

kill explorer



Либо просто

logoff