Batya

|
Posted: Wed Aug 17, 2011 15:10 Post subject: |
|
|
DemoZluk
Новый скрипт:
Code: | '=====================================================================
' Создание папки по имени текущего файла с перемещением в неё
' выделенных файлов и папок
' Параметры:
' {файл-список} {файл, по которому формируется имя создаваемой папки}
' Примеры параметров при вызове из TC:
' %L %P%N
' %L %T%N
' %L %P%M
' %L %T%M
'=====================================================================
Option Explicit
Dim FSO, FL, FF, F, NewPath, FullPath, Flag
With WScript
If .Arguments.Count = 0 Then
MsgBox "Не заданы параметры!" , vbOKOnly + vbCritical, "Внимание!"
.Quit
End If
If .Arguments.Count < 2 Then
MsgBox "Указаны не все параметры!", vbOKOnly + vbCritical, "Внимание!"
.Quit
End If
FL = .Arguments(0)
FF = .Arguments(1)
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
NewPath = FSO.GetParentFolderName(FF) & "\" & FSO.GetBaseName(FF) & "\"
If Not FSO.FolderExists(NewPath) Then FSO.CreateFolder(NewPath)
With FSO.OpenTextFile(FL, 1)
Do While Not .AtEndOfStream
F = Trim(.ReadLine)
If F <> "" Then
If FSO.FolderExists(F) Then
If Right(F, 1) = "\" Then F = Mid(F, 1, Len(F) - 1)
Flag = vbYes
FullPath = NewPath & FSO.GetFileName(F)
If FSO.FolderExists(FullPath) Then
Flag = MsgBox("Папка """ & FullPath & """ уже существует! Заменить?", vbYesNoCancel + vbExclamation, "Внимание!")
If Flag = vbCancel Then Wscript.Quit
If Flag = vbYes Then FSO.DeleteFolder(FullPath)
End If
If Flag = vbYes Then FSO.MoveFolder F, NewPath
End If
If FSO.FileExists(F) Then
Flag = vbYes
FullPath = NewPath & FSO.GetFileName(F)
If FSO.FileExists(FullPath) Then
Flag = MsgBox("Файл """ & FullPath & """ уже существует! Заменить?", vbYesNoCancel + vbExclamation, "Внимание!")
If Flag = vbCancel Then Wscript.Quit
If Flag = vbYes Then FSO.DeleteFile(FullPath)
End If
If Flag = vbYes Then FSO.MoveFile F, NewPath
End If
End If
Loop
.Close
End With
Set FSO = Nothing
Wscript.Quit |
_________________ Нет, я не сплю. Я просто медленно моргаю. |
|