Объединение выделенных папок в одну папку

[BeardFury78]

Интересует реализация одной цели: чтобы выделенные папки сливались в одну папку на другом панели, название которой будет браться из названиях папок плюс тире между ними. Как это должно выглядеть: есть папки "папка1", "папка2","папка3", после их выделения и запуска скрипта все их содержимое должно перемещаться в одну папку с названием "папка1 - папка2 - папка3", а после этого пустые папки должны удаляться. Если есть файлы с одинаковыми названиями, то лучше переименовать дублирующие названия, добавляя к ними в конце цифры в скобках.
Спасибо.

[Flasher]

BeardFury78
А почему тут фигурирует другая панель?

[BeardFury78]

Flasher
Чтобы можно было в одном месте объединять папки из результатов поиска, которые по отдельности располагаются в других местах дисков. Ну это как вариант.

[Flasher]

BeardFury78
Вроде того, но особо не тестировал:

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

'=============================================================
' Объединение выделенных папок в одну с комбинированным именем
' Параметры: %WL "<путь получателя>" "<разделитель имён>"
' Пример:    %WL "%T" " - "
'=============================================================
With WSH.Arguments
  C = .Count : If C = 0 Then WSH.Quit
  If C <> 3 Then MsgBox "Укажите 3 параметра!", 4144 : WSH.Quit
  List = .Item(0) : Targ = .Item(1) : Delim = .Item(2)
End With : Set ShA = CreateObject("Shell.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
With New RegExp
  .Pattern = "(^|\r\n).+[^\\](?=\r\n)" : .Global = True
  List = .Replace(FSO.OpenTextFile(List,,,-1).ReadAll, "")
  List = Left(List, Len(List) - 2)
  If InStr(List, vbNewLine) = 0 Then WSH.Quit
  .MultiLine = True : .Pattern = "\\$"
  Name = .Replace(List, "") : .Pattern = "^.+\\"
  Name = Replace(.Replace(Name, ""), vbNewLine, Delim)
End With : List = Split(List, vbNewLine)
With FSO.GetFolder(List(0)) .Name = Name : Path = .Path End With
Set oPath = ShA.NameSpace(Path) : On Error Resume Next
For i = 1 To Ubound(List)
  Fd = List(i) : Set Items = ShA.NameSpace(Fd).Items
  Items.Filter 73952, "*" : oPath.MoveHere Items, 4120
  Set Fd = FSO.GetFolder(Fd) : If Fd.Size = 0 Then Fd.Delete
Next : If StrComp(Path, FSO.BuildPath(Targ, Name)) Then _
FSO.MoveFolder Path, FSO.BuildPath(Targ, "\")

[BeardFury78]

Flasher
Скрипт работает так как я хотел. Но потом после первого перемещения создается еще один процесс перемещения, на этот раз всех файлов из диска C:\ в папку на другом панеле, приходится прерывать этот процесс.

[Flasher]

BeardFury78
Нужны все условия воспроизведения.

[BeardFury78]

Flasher
Ну как, просто выделяю папки, запускаю скрипт, эти папки успешно объединяются на другом панели, а потом открывается окно перемещения всех файлов из C:\ в ту же самую папку, на котором лежит объединенная папка. Параметры все прописал как в примере. Windows 7 64bit, TC 9.0 64bit.

[Flasher]

Подозрительно. Интересуют прежде всего пути источника и получателя. Они совпадают что ли?

[BeardFury78]

Flasher
Такое поведение наблюдается и когда пути источника и получателя совпадают и когда не совпадают.

[Flasher]

BeardFury78
Путей так и не увидел.

[BeardFury78]

Flasher
Да это могут быть любые пути. Такое поведение идет всегда с самыми разными путями. Ну вот один пример:
Папка источник - e:\Sandbox\, где лежат папки "1","2","3"
Папка получателя - e:\files\, где создается папка "1 - 2 - 3". А потом появляется окошко перемещения всех файлов из C:\, где потом приходится быстро нажимать "отмена", чтобы важные файлы не переместились оттуда. Мне кажется дело в скрипте или в системе. Неплохо было бы, если бы другие люди протестировали бы работу этого скрипта и сказали бы наблюдается ли у них это поведение или нет.

[Flasher]

Папка источник - e:\Sandbox\

Опа. Если это реальная песочница с включённым сервисом, то там вообще работа таких скриптов бесполезна. Там ничего и перемещаться не должно по идее.

[BeardFury78]

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

[Flasher]

BeardFury78
Кое-что исправил, но это вряд ли что-то изменит. Не понимаю, что может влиять на подобное. Сам момент появления папки в получателе производится в последнюю очередь. Откуда взяться там ещё чему-то, у меня в голове не укладывается.

[BeardFury78]

Flasher
Вот второй вариант как раз исправил баг с перемещениями файлов из C:\. Уже несколько раз проверял на разных путях, папки успешно объединяются и никакого перемещения файлов из C:\. Спасибо за скрипт!