Помогите допилить скрипт*(create subfolders ) - Компьютерный форум OSzone.net

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)

- - Помогите допилить скрипт*(create subfolders ) (http://forum.oszone.net/showthread.php?t=232361)

Помогите допилить скрипт*(create subfolders )

добрый вечер , помогите допилить
не могу создать subfolders
задача
1 создать subfolders (desktop, favorits , My documents ) в переменной (strDirectory) .
2 переписать Desktop , favorits , My Documents в новую папку (strDirectory)

Option Explicit
Dim objFSO, objFolder, objShell, strDirectory, filesys, WshShell, WshEnv, strusername, fso
strDirectory = InputBox("Enter Folder Name:", "Creating...")
'For cancel or blank
If strDirectory=Empty Then
WScript.Quit
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
'searche dublicate folders.
'Add open folders
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
WScript.Echo "Folder ''"& strDirectory &"'' found "
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "NEW FOLDER CREATED ''"& strDirectory &"''."
End If

Set WshShell = CreateObject("WScript.Shell")
Set WshEnv = WshShell.Environment("SYSTEM")
StrUsername = wshShell.ExpandEnvironmentStrings("%username%")
msgbox strUsername

Set filesys=CreateObject("Scripting.FileSystemObject")
If filesys.FolderExists(strDirectory) Then
filesys.CopyFolder "C:\Documents and settings\" & StrUsername & "\Desktop", (strDirectory)
End If

Set filesys=CreateObject("Scripting.FileSystemObject")
If filesys.FolderExists(strDirectory) Then
filesys.CopyFolder "C:\Documents and settings\" & StrUsername & "\application data\microsoft\signature", (strDirectory)
End If

If err.number = vbEmpty then
Set objShell = CreateObject("WScript.Shell")
objShell.run ("Explorer" &" " & strDirectory & "\" )
Else
WScript.echo "Usp..errore vbscript: " & err.number
End If

WScript.Quit

datosha, что именно у Вас не получается, и что означает «переписать» — переместить или скопировать?

Нужно чтобы создавалась по папки Desktop , My Documents , signature
В Новой папке и туда копирывались данные слокального профиля

пока толко создает новую папку и копирует Desktop .

Set filesys=CreateObject("Scripting.FileSystemObject")
If filesys.FolderExists(strDirectory) Then
filesys.CopyFolder "C:\Documents and settings\" & StrUsername & "\application data\microsoft\signature", (strDirectory) <-- как в таком случае создать и записать имя папки ?
End If

Так:

Цитата:

Цитата datosha

desktop, favorits , My documents »

или:

Цитата:

Цитата datosha

Desktop , My Documents , signature »

In InputBox "create new folder "
then copy to this folder desktop , favorits , my documents , ( folders ,subfolders , from local user )

Код:

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

'=============================================================================

wow , круто ,,,,, огромное спасибо .....