Перемещение/копирование 250 файлов из каждой подпапки

[Flasher]

BeardFury78
Добрый человек ошибается. Я потом выложу давно готовый вариант с выбором направления. Пока интернет на десктопе отвалился на некоторое время.

[BeardFury78]

Добрый человек ошибается.

Ну у меня после этого стали перемещаться файлы с старейшими датами модификации. Но конечно я буду ждать ваш вариант скрипта.

[Flasher]

BeardFury78
Есть ситуации, где результат будет неверным. Да и сам способ индусский.
Вот дополненный вариант (+ работа с файлами только на чтение):

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

'====================================== VBS =======================================
' Копирование/перемещение заданного числа изменённых первыми (по умолч.)/последними
' файлов из подкаталога структуры выбранных папок с сохранением относительных путей

' Условие: путь запуска - пустой

' Параметры: %WL "<путь получателя>" <число файлов> <copy/move>
' Дополнительные: <флаг последних правок: 1> <флаг рекурсии: 1>

' Примеры:   %WL "%T" 250 copy 0 1   |   %WL "C:\Мой каталог" 10 move
'==================================================================================

With WSH.Arguments
  C = .Count : If C = 0 Then WSH.Quit
  If C < 4 Then MsgBox "Укажите 4, 5, 6 параметров!", 4144 : WSH.Quit
  List = .Item(0) : Path = .Item(1) : Cnt = .Item(2) : Act = .Item(3)
  If C > 4 Then Last = .Item(4) : If C = 6 Then Rec = .Item(5)
End With : If LCase(Act) = "copy" Then Par = ", True"

Set Targ = CreateObject("Shell.Application").NameSpace(Path)
Set Sort = CreateObject("System.Collections.Sortedlist")
Set FSO  = CreateObject("Scripting.FileSystemObject")
IPath = FSO.BuildPath(FSO.GetAbsolutePathName(""), "\")
If IPath = FSO.BuildPath(Path, "\") Then WSH.Quit
Ln = Len(IPath) + 1 : Set List = FSO.OpenTextFile(List,,,-1)
Do : Fold = List.ReadLine
  If FSO.FolderExists(Fold) Then ForFolder Fold
Loop Until List.AtEndOfStream : List.Close
If Last = 1 Then FOL = "последними" Else FOL = "первыми"
If LCase(Act) = "copy" Then Act = " Копирование" Else Act = " Перемещение"
MsgBox Space(26) & "Выполнено!", 4160, Act & " изменённых " & FOL & " файлов      "

Sub ForFolder(Fd)
  Set IFold = FSO.GetFolder(Fd)
  For Each F In IFold.Files
    Sort.Add DateDiff("s", 0, F.DateLastModified) & F.Name, F.Name
  Next : DL = Sort.Count
  If DL Then
    RPath = FSO.BuildPath(FSO.BuildPath(Path, Mid(Fd, Ln)), "\")
    If Not FSO.FolderExists(RPath) Then Targ.NewFolder(Mid(IFold.Path, Ln))
    If Last = 1 Then UL = DL - Cnt : St = -1 Else St = 1 :_
    If CLng(Cnt) > DL Then UL = DL - 1 Else UL = Cnt - 1 End If : Dl = 1
    If UL < 0 Then UL = 0
    For i = DL - 1 To UL Step St
      Set File = FSO.GetFile(FSO.BuildPath(Fd, Sort.GetByIndex(i)))
      A = File.Attributes : R = 0
      If (A And 1) = 1 Then File.Attributes = A - 1 : R = 1
      Execute "File." & Act & " RPath" & Par : If R Then _
      FSO.GetFile(RPath & File.Name).Attributes = A :_
      If LCase(Act) = "copy" Then File.Attributes = A
    Next : Sort.Clear
  End If : If Rec = 1 Then For Each F in IFold.SubFolders : ForFolder F : Next
End Sub

[BeardFury78]

Flasher
Спасибо, поставил. Работает правильно. Правда, что я заметил: если выделять папки в панели результатов поиска, причем они располагаются в разных местах диска, и запустить скрипт, то из них файлы переносятся, но сами папки создаются с сокращенными названиями на конце (начало просто обрезается). А еще может создаваться корневая папка с обрезанным названием, внутри которых расположены другие папки, в которых по одному лежат нужные папки с полным названиям с правильным количеством файлов. Это тоже самое делается и с старым вариантом скрипта. В обычном режиме все пореносится верно и без ошибок.

[Flasher]

BeardFury78
В результатах поиска относительность не прочитаешь, там нет понятия корневого каталога, ибо поиск одним диском или папкой не ограничивается.

[BeardFury78]

Flasher
Тогда ладно. Спасибо за скрипт!

[sa]

Есть ситуации, где результат будет неверным.

Какие ситуации имеются в виду?

[Flasher]

А вот и "Добрый человек" объявился. Кто б сомневался (почерк не даст соврать).
Ситуаций хватает.
[cut="Например:"]

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

Set Sort = CreateObject("System.Collections.Sortedlist")

For Cnt = 1 To 8

	Sort.Clear : S = "" : L = ""

' Добрый человек: ——————————————————————————————————————————————————————————————————————————————————————————
Sort.Add DateDiff("s", 2958465, "24.12.2016 01:01:01") & "1.txt", "24.12.2016 01:01:01	1.txt"
Sort.Add DateDiff("s", 2958465, "24.12.2016 01:01:01") & "2.txt", "24.12.2016 01:01:01	2.txt"
Sort.Add DateDiff("s", 2958465, "22.12.2016 01:01:01") & "3.txt", "22.12.2016 01:01:01	3.txt"
Sort.Add DateDiff("s", 2958465, "23.12.2016 01:01:01") & "4.txt", "23.12.2016 01:01:01	4.txt"
Sort.Add DateDiff("s", 2958465, "24.12.2016 01:01:01") & "5.txt", "24.12.2016 01:01:01	5.txt"
Sort.Add DateDiff("s", 2958465, "22.12.2016 01:01:01") & "имя файла.txt", "22.12.2016 01:01:01	имя файла.txt"
Sort.Add DateDiff("s", 2958465, "23.12.2016 01:01:01") & "имя файла 2.txt", "23.12.2016 01:01:01	имя файла 2.txt"
Sort.Add DateDiff("s", 2958465, "24.12.2016 01:01:01") & "abc.txt", "24.12.2016 01:01:01	abc.txt"

	Dlimit = Sort.Count

	ULimit = Dlimit - Cnt

	For i = Dlimit - 1 To ULimit Step -1
		S = S & vbCr & Sort.GetByIndex(i)
	Next

' Flasher: —————————————————————————————————————————————————————————————————————————————————————————————————
Sort.Clear

Sort.Add DateDiff("s", 0, "24.12.2016 01:01:01") & "1.txt", "24.12.2016 01:01:01	1.txt"
Sort.Add DateDiff("s", 0, "24.12.2016 01:01:01") & "2.txt", "24.12.2016 01:01:01	2.txt"
Sort.Add DateDiff("s", 0, "22.12.2016 01:01:01") & "3.txt", "22.12.2016 01:01:01	3.txt"
Sort.Add DateDiff("s", 0, "23.12.2016 01:01:01") & "4.txt", "23.12.2016 01:01:01	4.txt"
Sort.Add DateDiff("s", 0, "24.12.2016 01:01:01") & "5.txt", "24.12.2016 01:01:01	5.txt"
Sort.Add DateDiff("s", 0, "22.12.2016 01:01:01") & "имя файла.txt", "22.12.2016 01:01:01	имя файла.txt"
Sort.Add DateDiff("s", 0, "23.12.2016 01:01:01") & "имя файла 2.txt", "23.12.2016 01:01:01	имя файла 2.txt"
Sort.Add DateDiff("s", 0, "24.12.2016 01:01:01") & "abc.txt", "24.12.2016 01:01:01	abc.txt"

	For i = 0 To Cnt - 1
		L = L & vbCr & Sort.GetByIndex(i)
	Next
'———————————————————————————————————————————————————————————————————————————————————————————————————————————

	MsgBox """Добрый человек"" (sa):" & vbCr & S & String(3, vbCr) & "Flasher:" & vbCr & L

Next

[/cut]

[sa]

Ситуаций хватает.

Сначала идут два файла от 22.12, затем два от 23.12 и в конце четыре от 24.12. Где ошибка?

[Flasher]

Сортировке должна касаться не только дат, но и имён.

[sa]

Где было какое-то требование сортировки по именам?

[Flasher]

Это естественная сортировка вне зависимости от каких-то условий.

[sa]

И она всегда является обязательной, если конкретно не указан какой-то другой тип сортировки?

[Flasher]

По сути - да, если не касаться историй с FAT32 и т. п.

[sa]

А как правильно надо задавать направление (по возрастанию или убыванию) в сортировке по именам (ведь в варианте с 2958465 она по сути тоже есть, только обратная)? Обратная получается, кстати, и для исходной задачи (посмотреть результат можно в тестовом примере, заменив везде 2958465 на 0).