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

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

Ответить
Настройки темы
VBS/WSH/JS - Перемещение файлов в только, что созданную папку из контекстного меню.

Пользователь


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

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


Здраствуйте...
Возможно, ли воплотить посредством написания скрипта на VBS перемещение в папку выделенных файлов из контекстного меню?
Что бы было более понятно, скажу, что такой пункт есть в программе "FileMenu Tools".
Пытался использовать:
Код: Выделить весь код
On Error Resume Next 
Dim Message, fso, Text, FolderName, FileName, Title
Message = "Введите название:"
Title = "Создание папки"
'создаем объект FileSystemObject в переменную fso
Set fso = CreateObject("Scripting.FileSystemObject")
FolderName = InputBox(Message, Title) 
Set Fldr = fso.CreateFolder ("" & FolderName)
и
Код: Выделить весь код
On error resume next
Dim objWshShell, strFolderName, strFullFolderName, Message, Title
Message = "Введите название:"
Title = "Создание папки"
Set objFSO      = WScript.CreateObject("Scripting.FileSystemObject")
Set objWshShell = WScript.CreateObject("WScript.Shell")
    strFolderName = InputBox(Message, Title) 
   strFullFolderName = objFSO.BuildPath(objWshShell.SpecialFolders("C , D ,"), strFolderName)
 If objFSO.FolderExists(strFullFolderName) Then
    WScript.Echo "Папка с таким именем уже существует."
Else
    objFSO.CreateFolder strFullFolderName
    WScript.Echo "Folder [" & strFullFolderName & "] created."
 End If
Set objWshShell = Nothing
Set objFSO      = Nothing
  WScript.Quit 0
Эти два скрипта отлично справляются со своей задачей, по созданию папок.Но вот, чтобы переместить в созданную этими скриптами папку файлы...Полный ступор.
Пробывал через:
Код: Выделить весь код
Set WshShell = CreateObject("WScript.Shell")
WshShell.SendKeys("^X")
и
Код: Выделить весь код
Set WshShell = CreateObject("WScript.Shell")
WshShell.SendKeys("^V")
Но не хватает знаний.Прошу помощи.Буду признателен.

Отправлено: 19:59, 08-12-2010

 

Аватара для Phoenix

Ветеран


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

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


OSArev, Как добавить в контекстное меню пункты “Копировать в папку” и “Переместить в папку”

оно?

Отправлено: 21:09, 08-12-2010 | #2



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

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


Пользователь


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

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


Цитата Phoenix:
оно? »
Не оно.
1.Выделяется файл
2. Выводится "InputBox"
3.Вводится имя папки.
4.Создаётся папка.
5.Файл вырезается и вставляется в эту созданную папку.
Я не могу реализовать вставку в папку.
Код: Выделить весь код
On Error Resume Next 
Dim Message, fso, Text, FolderName, FileName, Title
Message = "Введите название:"
Title = "Создание папки"

Set WshShell = CreateObject("WScript.Shell")  'вырезаю
WshShell.SendKeys("^X")

Set fso = CreateObject("Scripting.FileSystemObject") 'создаю папку
FolderName = InputBox(Message, Title) 
Set Fldr = fso.CreateFolder ("" & FolderName)

А тут надо вставить вырезанный объект.А как?
Как указать на вновь созданную папку?
Как узнать её имя и путь к ней?

Отправлено: 21:59, 08-12-2010 | #3


Пользователь


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

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


Возвращаюсь к своей маникальной идее средствами VBS "передрать" фукцию из FileMenuTools 'Перемещение в папку':
Код: Выделить весь код
'*************************************
Dim objWshShell, strFileName, strFullFileName
Set objFSO      = WScript.CreateObject("Scripting.FileSystemObject")
Set objWshShell = WScript.CreateObject("WScript.Shell")
'------------------------------------
' Создание папки(никаких проблем):
Dim objFSO, objFolder, objShell, strDirectory
 strDirectory = InputBox("Введите название папки:", "Пермещение объектов.") 
  If Len(strDirectory) = 0 Then
  strDirectory = WScript.Quit
End If 

 On Error Resume Next
   Set objFSO = CreateObject("Scripting.FileSystemObject") 
    If objFSO.FolderExists(strDirectory) Then 
   Set objFolder = objFSO.GetFolder(strDirectory) 
    Else
   Set objFolder = objFSO.CreateFolder(strDirectory) 
  End If
'----------------------------------- 
'Узнаём путь к новой папке:
 on error resume next
  Folderspec = strDirectory
   Set fso = CreateObject( "Scripting.FileSystemObject" ) 
   Set folder = fso.GetFolder(folderSpec)
'**************************
'Дальше идёт код заимствованный на одном из форумов Ru.Board,
'(честное слово, не помню где точно),cпасибо огромное автору, для копирования
Set FSO = CreateObject("Scripting.FileSystemObject")
set Args = WScript.Arguments
Set objShellApp = CreateObject("Shell.Application")
'------------------------------------------------------
'Перед запуском скрипта Folder должен быть создан, иначе ошибка.
Set objFolder = objShellApp.NameSpace(strDirectory)  

Dest = strDirectory
 
If Args.Count = 0 Then
  WScript.Quit
End If
    For i = 0 To Args.Count - 1
    CopyObj IsFileOrDir(Args.Item(i)), Args.Item(i)
 Next
  MsgBox "Скопировано"
'===========================================================
Function IsFileOrDir (ItemPath)
 
  If FSO.FileExists (ItemPath) Then
    IsFileOrDir = "File"
  Else
    IsFileOrDir = "Dir"
  End If
 
End Function
'===========================================================
Sub CopyObj (FileOrDir, ItemPath)
 
  Select Case FileOrDir
 
    Case "File"
 
      Set File = FSO.GetFile (ItemPath)
 
      File.Copy CreateDestFolders(Dirs)
 
    Case "Dir"
 
      Set Folder = FSO.GetFolder (ItemPath)      
 
      Folder.Copy CreateDestFolders(Dirs)
 
  End Select
 
End Sub
'===========================================================
Function CreateDestFolders(Dirs)
 
  SplitDirs = Split(Dirs, "\")
 
  DestFold = Dest
 
  For j = 0 To UBound(SplitDirs)
 
    NewDest = DestFold & "\" & SplitDirs(j)
 
    If Not FSO.FolderExists(NewDest) Then
     FSO.CreateFolder NewDest
    End If
    DestFold = NewDest
 
  Next
 
  CreateDestFolders = DestFold & "\"
 
End Function
Прописываю этот код в реестр с параметром "%1" и всё в порядке, но...
Всё в порядке для одного объекта. А при попытке скопировать несколько объектов - Inputbox запускается равнозначно количеству выделенных в меню объектов.
Подскажите, пожалуйста, как ограничить запуск InputBox так, чтобы это не влияло на количество копируемых объектов.
Извините, если эта тема кажется лёгкой - я новичёк, и ни как не могу это понять.
Спасибо.

Отправлено: 21:53, 11-02-2011 | #4


Пользователь


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

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


Многократный запуск InputBox - победил, при помощи создания временных файлов. Но пришлось создавать два скрипта.
Скрипт№1:
Код: Выделить весь код
Set FSO = CreateObject("Scripting.FileSystemObject")
'Узнаю имена перемещаемых объектов:
Dim Arg,objArgs,s
Set objArgs = WScript.Arguments 
For Each Arg In objArgs
  s=s & Arg & vbCrLf 
Next
'Пишу имена в файл:
  Set f = FSO.OpenTextFile("C:\Windows\OSA\Moving_to_folder\testfile.log", 8, True) 
 f.Write s
f.Close 
'Узнаю путь для создания новой папки:
 If WScript.Arguments.Count = 1 Then
   sFile   = WScript.Arguments.Item(0)
 End If

on error resume next
Filespec = sFile 
 Set folder = fso.GetFolder(fileSpec)
 Set file   = fso.GetFile(fileSpec) 
'Пишу путь в файл:
  Set f1 = FSO.OpenTextFile("C:\Windows\OSA\Moving_to_folder\testfile1.log",  2, True) 
 f1.WriteLine file.ParentFolder & "\"
 F1.WriteLine folder.ParentFolder & "\"
 f1.Close
'Запускаю второй скрипт:
Set WshShell = CreateObject ("WScript.Shell")
WSHShell.Run "C:\Windows\OSA\Moving_to_folder\Start1.vbs",,True
Скрипт№2:
Код: Выделить весь код
'Запрещаю повторный запуск скрипта:
Set FSO = CreateObject("Scripting.FileSystemObject")
  If FSO.FileExists("C:\Windows\OSA\Moving_to_folder\" & WScript.ScriptName & ".txt") Then
    WScript.Quit
End If
    FSO.CreateTextFile "C:\Windows\OSA\Moving_to_folder\" & WScript.ScriptName & ".txt"
'Читаю путь для содания папки;
Set objFSO = CreateObject ("Scripting.FileSystemObject")
 filelocation = "C:\Windows\OSA\Moving_to_folder\testfile1.log" 
  If objFSO.FileExists(filelocation) Then 
Set logfile = objFSO.OpenTextFile(filelocation, 1) 

Do While Not logfile.AtEndOfStream
   	strcontents = "" 
	strcontents = logfile.ReadLine 
	    If Not strcontents = "" then 
'Создаю папку:
strRoot=strcontents

Set objFolder=objFSO.GetFolder(strRoot)
Set colFolders=objFolder.SubFolders

strFolder=InputBox("Введите имя папки:", "Перемещение в создаваемую папку:")
  If objFSO.FolderExists(strRoot & strFolder) Then
Else
    colFolders.Add strFolder
End If
End if 	    
  Loop 
  logfile.Close
end if 
'Удаляю временный файл:
   objFSO.DeleteFile "C:\Windows\OSA\Moving_to_folder\testfile1.log"
'Читаю имена перемещаемых объектов:
 filelocation = "C:\Windows\OSA\Moving_to_folder\testfile.log" 
  If objFSO.FileExists(filelocation) Then 
Set logfile = objFSO.OpenTextFile(filelocation, 1) '
Do While Not logfile.AtEndOfStream '
   	strcontents = "" 
	strcontents = logfile.ReadLine 
    If Not strcontents = "" then 
'Перемещаю в созданную папку:
Set FSO =CreateObject("scripting.FileSystemObject") 
   on error resume next
    fso.movefolder strcontents , strRoot & strFolder & "\"
    fso.movefile strcontents , strRoot & strFolder & "\"
End if 	   
  Loop 
  logfile.Close 
end if 
'Удаляю временные файлы:
   objFSO.DeleteFile "C:\Windows\OSA\Moving_to_folder\testfile.log"

      FSO.DeleteFile "C:\Windows\OSA\Moving_to_folder\" & WScript.ScriptName & ".txt"
Но проявилась ещё одна бяка.
Работает только для 18-и, 20-и объектов. Может, кто подскажет, как победить это несчастье. На данном этапе не могу этого догнать.
Спасибо.

Отправлено: 12:35, 20-02-2011 | #5


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


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

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


подскажите еще, пожалуйста

есть компьютерный класс

шаловливые юзеры очень любят менять всевозможные атрибуты, мишуру
и оформления - например, в Сервис->Свойства папки->Общие и ->Вид
- насколько я понимаю в самой OC (Windows XP Prof. SP2)
предусмотрены значения "по умолчанию"

как написать такой скрипт, чтобы он, не мудрствуя лукаво,
сам возвращал эти самые "умолчания"
при каждом новом входе User'a в систему (или презагрузке)?

подскажите если кто знает

* * *

и еще - если по теме

оптимизировать скрипт
чтобы перемещал созданные на рабочем столе Юзера файлы .doc, .xls и прочую ересь
в папку C:\User\"дата создания"\


Спасибо

-------
sit mens sana in corpore sano


Отправлено: 03:17, 25-02-2011 | #6


Ветеран


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

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


Windows SteadyState: вопросы и ответы

Отправлено: 06:17, 25-02-2011 | #7


Ветеран


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

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


Зравствуйте
OSArev
Если не тяжело, можете рассказать как и куда девать скрипты, я в этом не очень, а вот этот пункт из FileMenu Tools очень хочется.
Еще использую программу RightClicker Pro 1.44 - очень хороша, а можно как-то вставить пункты FileMenu Tools в ее конт. меню, это
было бы вообще идеально так как они дополняют друг друга. В RightClicker Pro 1.44, кстати, есть пункт "поместить в..." по типу
переместить в папку в FileMenu Tools, но там нельзя ввести свое имя папки - по умолчанию создается папка с именем "Новая папка",
не продумали, а как это изменить не знаю, через реестр ничего не получается.

Отправлено: 15:05, 25-02-2011 | #8


Пользователь


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

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


Цитата alpap:
можете рассказать как и куда девать скрипты »
Я, так понимаю, где их разместить и как их прописать?
Напримере моих двух скриптов :Скрипт№1 и Скрипт№2 - это будет выглядеть так:
1.Размещаете их где угодно.
2.Что касается реестра. У меня скрипты расположены по адресу: "C:\Windows\OSA\Moving_to_folder".
Значит создаём reg-файл для этого пути.
а)Ведущим скриптом является Скрипт№1, значит reg-файл надо создать для него.
б)Т.к. скрипт будет использоваться для всех объектов файловой системы, то прописываем скрипт в "AllFilesystemObjects"
Код: Выделить весь код
Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\AllFilesystemObjects\shell\Переместить в папку с текущей датой]
"icon"="shell32.dll,-21"

[HKEY_CLASSES_ROOT\AllFilesystemObjects\shell\Переместить в папку с текущей датой\command]
@="WScript C:\\Windows\\OSA\\To_folder_on_date\\To_folder_on_date.vbs \"%1\""
Что касается программы "RightClicker Pro 1.44" - не разу не работал. А вот в "FileMenuTools"
можно без проблем добавлять свои пунткы.

Отправлено: 23:38, 25-02-2011 | #9


Пользователь


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

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


Цитата homo_novu5:
оптимизировать скрипт
чтобы перемещал созданные на рабочем столе Юзера файлы .doc, .xls и прочую ересь
в папку C:\User\"дата создания"\ »
Вот есть хороший скрипт(на этом форуме!!!), только, что проверил:
http://forum.oszone.net/thread-86094.html
Можно переделать под свои нужды.
Код: Выделить весь код
Dim FSO, FldN, Fls, Fl, DtN, FlN
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")

FldN = "C:\Users\OSA\Desktop"   ' Ваш путь откуда
If Not FSO.FolderExists(FldN) Then
  MsgBox "Папка """ & FldN & """ не существует. ", vbExclamation, "Ошибка"
  WScript.Quit
End If

Set Fls = FSO.GetFolder(FldN).Files
For Each Fl In Fls
 ' "C:\Users\" - Путь куда перемещать.
  DtN = FSO.BuildPath("C:\Users\", GetDateName(Fl.DateLastModified))
  If Not FSO.FolderExists(DtN) Then FSO.CreateFolder DtN

  FlN = FSO.BuildPath(DtN, Fl.Name)
  If FSO.FileExists(FlN) Then FSO.DeleteFile FlN, True
  Fl.move FlN

MsgBox "Скрипт завершен. ", vbInformation, "Финиш"
WScript.Quit

Private Function GetDateName(Dt)
  Dim M, D

  M = Month(Dt)
  D = Day(Dt)
  If M < 10 Then M = "0" & M
  If D < 10 Then D = "0" & D

  GetDateName = Year(Dt) & "-" & M & "-" & D
End Function

Последний раз редактировалось OSArev, 26-02-2011 в 00:45.


Отправлено: 00:27, 26-02-2011 | #10



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

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

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
Интерфейс - [решено] задержка при вызове контекстного меню файлов twisted1 Microsoft Windows 2000/XP 34 24-05-2017 11:10
Интерфейс - Настройка контекстного меню файлов/папок/дисков .:[все вопросы]:. zhecka Microsoft Windows 2000/XP 294 23-09-2015 19:34
CMD/BAT - [решено] Перемещение устаревших файлов из папки в резервную папку zavoruev Скриптовые языки администрирования Windows 22 28-05-2010 14:04
Интерфейс - запрет контекстного меню только на рабочем столе alexataa Microsoft Windows 2000/XP 0 01-03-2010 00:20
не могу создать папку из контекстного меню Yarikus Microsoft Windows 95/98/Me (архив) 0 08-01-2005 10:48




 
Переход