Flasher
|
 Posted: Sun Nov 08, 2015 00:15 Post subject: |
 |
|
Hjkma
Слил возможности в один скрипт. Можно протестировать.
| Code: | '=============================== VBS ===============================
' Рассортировка групп одноимённых до знака "-" или "_" файлов
' из выбранных папок в каталоги, соответствующие числовому диапазону
'
' Параметры: %WL "<путь к целевой папке>"
' Дополнительные параметры: <не/удалять пустые папки: 0/1>
' <числовые диапазоны: MIN-MAX>
' Числовые диапазоны должны быть несмежными и разделяться пробелами.
' Если диапазоны не указаны или группа файлов не вписывается
' и в последний диапазон, то перенос производится в каталоги
' с диапазонами +10 (1-10, 11-20 и т. д.).
' Примеры: %WL "%T" 1 | %WL D:\MyFolder 0 1-5 8-15 19-25
'===================================================================
Option Explicit : Dim Title, List, ODir, Cnt,_
Del, FSO, Dict, ShA, Folder, Filt, Chek, Items
Title = " Перемещение файлов по группам каталогов "
With WScript.Arguments
Cnt = .Count : If Cnt = 0 Then WScript.Quit
If Cnt < 2 Then MsgBox _
"Укажите не менее 2-х параметров!", 4144, Title : WScript.Quit
List = .Item(0) : ODir = .Item(1) : If Cnt > 2 Then Del = .Item(2)
If Cnt > 3 Then Dim P, S, Sp
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dict = CreateObject("Scripting.Dictionary")
Set ShA = CreateObject("Shell.Application")
Set List = FSO.OpenTextFile(List,,,-1)
Do : Folder = List.ReadLine
If FSO.FolderExists(Folder) Then
Set Folder = ShA.NameSpace(Folder)
Set Items = Folder.Items
Items.Filter 8384, "*_*.*" : Move Items, "_", Chek
Items.Filter 8384, "*-*.*" : Move Items, "-", Chek
If Del Then
Items.Filter 8416, "*"
If Items.Count = 0 Then FSO.GetFolder(Folder.Self.Path).Delete
End if
End If
Loop Until List.AtEndOfStream
If Chek = 1 Then MsgBox "Задание успешно выполнено!", 4160, Title _
Else MsgBox "Файлы с заданным условием отсутствуют!", 4144, Title
Sub Move(Itms, Sym, Chk)
Dim FItems, FN, BN, LN, Ext, F, Nm, Span, OutDir
Set FItems = Folder.Items
For Each FN in Itms
BN = FSO.GetBaseName(FN) : Ext = FSO.GetExtensionName(FN)
LN = Left(BN, InStrRev(BN, Sym)) : F = LN & ":" & Ext
If Not Dict.Exists(F) Then
Dict.Add F, "" : FItems.Filter 8384, LN & "*." & Ext
Nm = FItems.Count : Span = ""
If Cnt > 3 Then
For P = 3 To Cnt - 1
S = WScript.Arguments(P) : Sp = Split(S, "-")
If Nm>=Abs(Sp(0)) And Nm<=Abs(Sp(1)) Then Span=S : Exit For
Next
End If
If Cnt < 4 Or (Cnt > 3 And IsEmpty(Span)) Then
If Nm/10 = Fix(Nm/10) Then Nm = Nm - 1
Span = Int((Nm - 10)/10)*10 + 11 & "-" & Int((Nm + 10)/10)*10
End If
If Span <> "" Then
OutDir = FSO.BuildPath(ODir, "[" & Span & "] файлов в группах")
If Not FSO.FolderExists(OutDir) Then FSO.CreateFolder(OutDir)
ShA.NameSpace(OutDir).MoveHere FItems, 280 : Chk = 1
End If
End If
Next : Dict.RemoveAll
End Sub |
_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
Last edited by Flasher on Sun Nov 08, 2015 04:52; edited 1 time in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
