Flasher

|
Posted: Wed Oct 12, 2011 10:16 Post subject: |
|
|
Code: | '======================================================================
' Перемещать файлы и папки, указанные в файлах-списках
' в папки с базовыми именами этих файлов-списков
' Параметры: %L <путь_назначения\>
' Пример: %L "%T"
'======================================================================
L = vbNewLine
D = InputBox(L&L&L&"Введите число отсекаемых компонентов " & L &_
"в началах путей, записанных" & L & "в выделенные файлы :",_
Space(13) & "Перемещение файлов и папок по спискам")
If Trim(D) = "" Or Not IsNumeric(D) Then Wscript.Quit
With CreateObject("Scripting.FileSystemObject")
Set TF = .OpenTextFile(WScript.Arguments(0), 1)
Do While Not TF.AtEndOfStream
F = TF.ReadLine
If F > vbNullString And .FileExists(F) Then
Trg = WScript.Arguments(1) & .GetBaseName(F)
If Not .FolderExists(Trg) Then .CreateFolder Trg
For Each Fn in Split(.OpenTextFile(F, 1).ReadAll, vbNewLine)
Fn = Trim(Fn)
If Fn <> "" And Mid(Fn, 2, 1) = ":" Then
Fx = Fn
Do While Abs(D) =< Abs(Ubound(Split(Fx, "\")))
Fx = .GetParentFolderName(Fx)
Loop
FPath = Trg & "\" & .GetParentFolderName(Mid(Fn, Len(Fx)+2))
If Not .FolderExists(FPath) Then .CreateFolder FPath
If .FolderExists(Fn) Then .GetFolder(Fn).Move FPath & "\"
If .FileExists(Fn) Then .GetFile(Fn).Move FPath & "\"
End If
Next
End If
Loop
TF.Close
End With |
Last edited by Flasher on Wed Oct 12, 2011 17:16; edited 7 times in total |
|