Код:
'============================================
'Перенос содержимого десктопа пользователя
'============================================
On Error Resume Next
Set SHELL = CreateObject ("WScript.Shell")
Set SF = SHELL.SpecialFolders
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(SF("Desktop"))
Set colSubfolders = objFolder.Subfolders
Set WshNet = CreateObject ("WScript.Network")
Set objNet = WScript.CreateObject("WScript.Network")
Set FSO = CreateObject("scripting.filesystemobject")
sUserName = WshNet.UserName
folderToCheckFor = "\\filesrv\profiles$\"+sUserName
If (FSO.FolderExists(folderToCheckFor)) = False Then
FSO.CreateFolder(folderToCheckFor)
End If
'Используя рекурсию сбрасываем атрибуты всех файлов во всех каталогах и подкаталогах десктопа.
'Необходимо для последующего их удаления.
Set objParentFolder = objFSO.GetFolder(SF("Desktop"))
ShowSubfolders objParentFolder
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
Set objSubFolder = objFSO.GetFolder(Subfolder.Path)
ShowSubFolders Subfolder
For Each efile in objSubFolder.Files
Set gFILE = objFSO.GetFile (efile)
gFILE.Attributes = 0
Next
Next
End Sub
'копируем с последующим удалением все каталоги десктопа (соответственно с их содержимым).
'Использование здесь CopyFolder вместо MoveFolder связано с возможностью метода CopyFolder перезаписывать файл,
'если такой существует в целевой папке.
For Each objSubfolder in colSubfolders
'WScript.Echo objFSO.GetFolder(SF("Desktop"))+"\"+objSubfolder.Name
'WScript.Echo DDir+WshNet.UserName+"\"
objFSO.CopyFolder objFSO.GetFolder(SF("Desktop"))+"\"+objSubfolder.Name, folderToCheckFor+"/"
objFSO.DeleteFolder objFSO.GetFolder(SF("Desktop"))+"\"+objSubfolder.Name
Next
'теперь перебираем все файлы которые находятся на рабочем столе, и если их тип не ярлык,
'то сбрасываем атрибут на 0, копируем и убиваем.
For Each efile in objFolder.Files
Set gFILE = objFSO.GetFile (efile)
fEXT = objFSO.GetExtensionName (efile.Path)
If LCase (fEXT)<>"lnk" then
gFILE.Attributes = 0
objFSO.CopyFile efile, folderToCheckFor+"/"
objFSO.DeleteFile efile
End If
Next
