Перемещение групп файлов согласно числовому диапазону

[Flasher]

1) Эти папки все в одной, или их выделять ещё потребуется?

Глубина относительно главной папки у них - 1? Или есть ещё глубже?

[Hjkma]

1) да, наверное в некоторых местах будет на уровень ниже, а некоторые папки еще глубже. но я могу все папки переместить на один одинаковый уровень

[Flasher]

Я об этом не писал. Всё будет происходить автоматически. Прошу ответить на вопрос про необходимость выделения.

[Hjkma]

Я об этом не писал. Всё будет происходить автоматически. Прошу ответить на вопрос про необходимость выделения.

я отредактировал пост, просто увидел только цитату до того как вы отредактировали пост

[Flasher]

Я понимаю. Можно и не перемещать, если накладно. Я так ответ про выделение не увидел.

Ещё раз см. P.S.

[Hjkma]

Я понимаю. Можно и не перемещать, если накладно. Я так ответ про выделение не увидел.

Я к сожалению наверное не совсем понимаю вопрос. Выделить папки для чего?

[Flasher]

Для обработки только нужных, если они вперемешку с другими.

[Hjkma]

Да, можно переместить все требуемые папки в одну папку, а потом работать уже над этой папкой.

[Flasher]

Т.е. всё-таки вперемешку? Если да, то можно либо выделять избранные после находения всех папок структуры либо как выше предложено. Что удобнее?

[Hjkma]

Flasher
Я если честно не знаю как это будет выглядеть, наверное нужно чтобы можно было сразу доставать нужные файлы из всех папок и переместить их в папки для категории файлов от 1 до 10, от 11 до 20 и так далее.

[Flasher]

Hjkma
Выглядит это элементарно. Вызвать поиск > на вкладке "Дополнительно" отметить атрибут "Каталог" > ENTER. После из списка выделить нужные, скрипт их обработает.

[Hjkma]

Flasher
хорошо, нормальный способ

[Flasher]

Hjkma
Чуть не забыл. А может быть такое, что нумерация начинается не 1? И может некоторых номеров не доставать?
И куда в таком случае пойдёт, скажем, такая группа - файл_9.txt, файл_10.txt, файл_21.txt?

[Hjkma]

Flasher
Нет, у меня нету таких файлов, все нумеровалось автоматически и файлы я не удалял, так что все полностью нумеровано. Также может быть и что нумерация будет иметь вид типа _1.img, так и -1.img, а также есть расширение png и соответственно _1.png и -1.png.

[Flasher]

Hjkma, в таком случае я беру не по номерам, а по числу:

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

'=============================== 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