[Iska]

Код:

Option Explicit

Const BIF_RETURNONLYFSDIRS = &H1
Const BIF_USENEWUI         = &H50

Const ssfDRIVES = &H11


Dim objShell
Dim objFSO

Dim objDestFolder
Dim strDestFolder

Dim strPath

Dim objSourceFolder
Dim strSourceFolder


Set objShell = WScript.CreateObject("Shell.Application")
Set objFSO   = WScript.CreateObject("Scripting.FileSystemObject")

Set objDestFolder = objShell.BrowseForFolder(0, "Select destination folder", BIF_RETURNONLYFSDIRS + BIF_USENEWUI, ssfDRIVES)

If Not objDestFolder Is Nothing Then
	With objFSO
		strDestFolder = objDestFolder.Self.Path
		
		If .FolderExists(strDestFolder) Then
			For Each strPath In Array("shell:Desktop", "shell:Favorites", "shell:Personal")
				Set objSourceFolder = objShell.NameSpace(strPath)
				
				If Not objSourceFolder Is Nothing Then
					strSourceFolder = objSourceFolder.Self.Path
					
					.CopyFolder strSourceFolder, .BuildPath(strDestFolder, .GetBaseName(strSourceFolder)), True
					
					Set objSourceFolder = Nothing
				Else
					WScript.Echo "Can't determine [" & strPath & "] source folder"
				End If
			Next
		Else
			WScript.Echo "Can't determine [" & strDestFolder & "] destination folder"
		End If
	End With
End If

Set objFSO   = Nothing
Set objShell = Nothing

WScript.Quit
'=============================================================================