Flasher

|
Posted: Sun May 06, 2012 12:03 Post subject: |
|
|
Code: | '======================================================================
' Перемещение выделенных папок при условии нахождения в них файлов
' со всеми указанными расширениями
' Параметры: %WL "<путь назначения>" <фильтр расширений через запятую>
' Пример: %WL "%T" txt,lst,log
'======================================================================
With WScript.Arguments
C = .Count : If C = 0 Then WScript.Quit
On Error Resume Next
List = .Item(0) : Path = .Item(1) : Filt = .Item(2)
On Error Goto 0
If C < 3 Then : MsgBox "Укажите 3 параметра!", 4144 : Wscript.Quit : End if
End With : If Right(Path, 1) <> "\" Then Path = Path & "\"
Sp = Split(Filt,",") : Max = Ubound(Sp) + 1
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each F in Split(FSO.GetFile(List).OpenAsTextStream(1, -1).ReadAll, vbNewLine)
If F > vbNullString Then
If FSO.FolderExists(F) Then
With CreateObject("Shell.Application")
Set P1 = .NameSpace(F).Items
Set P2 = .NameSpace(Path)
End With
If Len(Filt) > 0 Then
For Each Fi in Sp
P1.Filter 96, "*." & Fi : If P1.Count > 0 Then Ch = Ch + 1
Next
If Max = Ch Then
Folder = Path & FSO.GetFileName(F) : P2.MoveHere F, 16
End If : Ch = 0 : Set P1 = Nothing : Set P2 = Nothing
End If
End If
End If
Next : Set FSO = Nothing : WScript.Quit |
|
|