Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBS/WSH/JS - Помогите допилить скрипт*(create subfolders )

Ответить
Настройки темы
VBS/WSH/JS - Помогите допилить скрипт*(create subfolders )

Новый участник


Сообщения: 4
Благодарности: 0

Профиль | Отправить PM | Цитировать


добрый вечер , помогите допилить
не могу создать 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

Отправлено: 18:44, 08-04-2012

 

Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать


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

Отправлено: 23:51, 08-04-2012 | #2



Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети.

Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля.


Новый участник


Сообщения: 4
Благодарности: 0

Профиль | Отправить PM | Цитировать


Нужно чтобы создавалась по папки 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

Отправлено: 00:02, 09-04-2012 | #3


Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать


Так:
Цитата datosha:
desktop, favorits , My documents »
или:
Цитата datosha:
Desktop , My Documents , signature »
?

Отправлено: 00:27, 09-04-2012 | #4


Новый участник


Сообщения: 4
Благодарности: 0

Профиль | Отправить PM | Цитировать


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

Отправлено: 00:47, 09-04-2012 | #5


Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать


Код: Выделить весь код
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
'=============================================================================
Это сообщение посчитали полезным следующие участники:

Отправлено: 01:42, 09-04-2012 | #6


Новый участник


Сообщения: 4
Благодарности: 0

Профиль | Отправить PM | Цитировать


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

Отправлено: 16:46, 09-04-2012 | #7



Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBS/WSH/JS - Помогите допилить скрипт*(create subfolders )

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
Помогите поставить СКРИПТ!!! MozgNeo Вебмастеру 29 29-09-2013 13:42
Create Ringtone 4.99.8 OSZone Software Новости программного обеспечения 0 19-05-2010 15:30
C compiler cannot create executables Arrest Общий по Linux 16 27-05-2007 00:36
ошибка can't create socket slaine Microsoft Windows 2000/XP 0 04-11-2006 13:29
Помогите найти скрипт на JS rfcr Вебмастеру 9 11-08-2006 19:59




 
Переход