Total Commander

Код: Выделить всё

'================================ 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,_
" Полимитное перемещение файлов в номерные папки      "