'================================ VBS =================================
' Перемещение выбранных файлов в создаваемые папки с номерными именами,
' разбивая их по группам в рамках заданного лимита суммарного размера
' Параметры: %WL "<путь получателя>" <верхний лимит размера папок в Мб>
' Ключ добавки цепочки подкаталогов: /chain:<цепочка>
' Ключ смены начала счётчика с единицы на двойку: /2
' Примеры: %WL "%T" 100
' %WL "%P" 1000 /2
' %WL "%T" 2000 /chain:NewFolder
' %WL "%P" 4000 /chain:"Folder 1\Folder 2\Folder 3" /2
Option Explicit
'========= Минимальное число цифр в именах создаваемых папок ==========
Const Num = 1
'======================================================================
Dim C, i, Chain, List, Targ, Sum, FSO, oDisk, F, Size, Folder
With WSH.Arguments
If .UnNamed.Count = 0 Then WSH.Quit
If .Named.Exists("2") Then i = 2 Else i = 1
List = .Item(0) : Targ = .Item(1) : Sum = .Item(2) * 1048576
If .Named.Exists("chain") Then Chain = "\" & .Named("chain")
End With: Set FSO = CreateObject("Scripting.FileSystemObject")
Set oDisk = CreateObject("Shell.Application").NameSpace(FSO.GetDriveName(Targ))
With FSO.OpenTextFile(List,,,-1)
Do : F = Trim(.ReadLine)
If FSO.FileExists(F) Then
Set F = FSO.GetFile(F) : Size = Size + F.Size
If Size >= Sum Then Size = F.Size : i = i + 1
If Size = F.Size Then _
Folder = FSO.BuildPath(Targ, Right(String(Num - 1,"0") &_
i, Num)) & Chain : oDisk.NewFolder Mid(Folder, 4)
F.Move Folder & "\"
End If
Loop Until .AtEndOfStream : .Close
End With
MsgBox Space(18) & " Выполнено!", 4160,_
" Полимитное перемещение файлов в номерные папки " |