Возвращаюсь к своей маникальной идее средствами 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 так, чтобы это не влияло на количество копируемых объектов.
Извините, если эта тема кажется лёгкой - я новичёк, и ни как не могу это понять.
Спасибо.
