Добавлено: Пт ноя 06, 2015 05:13
Глубина относительно главной папки у них - 1? Или есть ещё глубже?Flasher писал(а):1) Эти папки все в одной, или их выделять ещё потребуется?
Форум поддержки пользователей Total Commander
https://forum.wincmd.ru/
Глубина относительно главной папки у них - 1? Или есть ещё глубже?Flasher писал(а):1) Эти папки все в одной, или их выделять ещё потребуется?
я отредактировал пост, просто увидел только цитату до того как вы отредактировали постFlasher писал(а):Я об этом не писал. Всё будет происходить автоматически. Прошу ответить на вопрос про необходимость выделения.
Я к сожалению наверное не совсем понимаю вопрос. Выделить папки для чего?Flasher писал(а):Я понимаю. Можно и не перемещать, если накладно. Я так ответ про выделение не увидел.
Код: Выделить всё
'=============================== VBS ===============================
' Рассортировка групп одноимённых до знака "-" или "_" файлов
' из выбранных папок в каталоги, соответствующие числовому диапазону
'
' Параметры: %WL "<путь к целевой папке>" <удалять пустые папки: 1>
' Примеры: %WL "%T" 1 | %WL D:\MyFolder
'===================================================================
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 = 1 Or Cnt > 3 Then MsgBox "Укажите 2 или 3 параметра!", _
4144, Title : WScript.Quit
List = .Item(0) : ODir = .Item(1) : If Cnt = 3 Then Del = .Item(2)
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dict = CreateObject("Scripting.Dictionary")
Set ShA = CreateObject("Shell.Application")
Set List = FSO.OpenTextFile(List,,,-1)
Do : Set Folder = ShA.NameSpace(List.ReadLine)
If Folder.Self.IsFolder Then
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, 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 : If Nm/10 = Fix(Nm/10) Then Nm = Nm - 1
OutDir = FSO.BuildPath(ODir, "[" & Int((Nm-10)/10)*10+11 &_
"-" & Int((Nm + 10)/10) * 10) & "] файлов в группах"
If Not FSO.FolderExists(OutDir) Then FSO.CreateFolder(OutDir)
ShA.NameSpace(OutDir).MoveHere FItems, 280 : Chk = 1
End If
Next : Dict.RemoveAll
End Sub