Flasher
|
 Posted: Thu Oct 13, 2011 14:24 Post subject: |
 |
|
| Riemann wrote: | | или надо скрипт допиливать? |
| Code: | '====================================================================
' Создание подкаталогов внутри выделенных папок по имени файла
' с первым расширением в заданном фильтре исключений
' и перемещение в них остальных файлов
' Параметры: %L <фильтр расширений игнорируемых файлов через запятую>
' Пример: %L avi,mkv,mp4,flv,wmv
'====================================================================
With WScript.Arguments
If .Count = 0 Then Wscript.Quit
List = .Item(0)
Filt = .Item(1)
If .Count = 1 Then
MsgBox "Укажите 2 параметра!",_
vbExclamation, " Перемещение содержимого каталогов"
Wscript.Quit
End If
End With
C = InStr(Filt, ",")
If C > 0 Then Ext = Left(Filt, C-1) Else Ext = Filt
Set D = CreateObject("Scripting.Dictionary")
With CreateObject("Scripting.FileSystemObject")
Set TempFile = .OpenTextFile(List, 1)
Do While Not TempFile.AtEndOfStream
Fd = TempFile.ReadLine
If .FolderExists(Fd) Then
On Error Resume Next
For Each F in .GetFolder(Fd).Files
If StrComp(Ext, .GetExtensionName(F), 1) = 0 Then
NF = Left(F, Len(F)-Len(Ext)-1) & "\"
If Not .FolderExists(NF) Then .CreateFolder NF
Exit For
End If
Next
For Each Fi in Split(Filt,",")
D.Add LCase(Fi), ""
Next
For Each F in .GetFolder(Fd).Files
If Not D.Exists(LCase(.GetExtensionName(F))) Then .MoveFile F, NF
Next
End If
Loop
TempFile.Close
End With
Set D = Nothing
WScript.Quit |
|
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
