Копирование массива каталогов с одинаковыми именами

[mythblu84]

Добрый День.

Как осуществить копирование большого количества найденных каталогов выведенных на панель. Без слияния каталогов с одинаковыми именами.

Пример
После поиска на панели есть каталоги

c:\xx\1\
c:\xx\2\
c:\zz\1\
c:\zz\2\
c:\cc\2\

скопировать нужно в 1 каталог с сохранением исходного количества файлов в каждой папке.Чтоб получилось

c:\all\1\
c:\all\1_1\
c:\all\2\
c:\all\2_1\
c:\all\2_2\
c:\all\2_3\

просто через F5 получается все файлы сливаются в 1 папку

[MVV]

Поможет плагин типа TreeCopyPlus. Ставишь его, выделяешь файлы, жмешь Alt+F5 (упаковать) и выбираешь его. Он копирует с сохранением структуры.

[Flasher]

mythblu84
Скрипт несложный. Пока времени нет. Может, вечером, если не опередят.

MVV
Это подойдёт, только если совпавшие каталоги не требуется хранить в одной директории на одной глубине.

[mythblu84]

Поможет плагин типа TreeCopyPlus. Ставишь его, выделяешь файлы, жмешь Alt+F5 (упаковать) и выбираешь его. Он копирует с сохранением структуры.

Не он мне копирует всю структуру получается

c:\all\c\xx\1\
c:\all\c\xx\2\
c:\all\c\zz\1\ и тд

[Flasher]

mythblu84
Там же в настройках задаётся число отсекаемых компонентов в началах путей.

Обещанное:

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

'=============================================================
' Копировать выделенные папки с переименованием при совпадении
' Параметры: %WL "<путь_назначения>"
' Пример:    %WL "%T"
' если указан 3-й параметр (например, "1"), то перемещать
'=============================================================
With WScript.Arguments
  C = .Count : If C = 0 Then WScript.Quit
  List = .Item(0) : Path = .Item(1) : Const M = 1
End With : If Right(Path, 1) <> "\" Then Path = Path & "\"
With CreateObject("Scripting.FileSystemObject")
  Set TF = .GetFile(List).OpenAsTextStream(1, -1)
  Do Until TF.AtEndOfStream
    F = Trim(TF.ReadLine)
    If F > vbNullString And .FolderExists(F) Then
      Name = .GetFileName(F) : FN = Name : n = 0
      Do While .FolderExists(Path & Name)
        n = n + 1
        If l < 10^M Then PFix = Right(String(M, "0") & n, M) Else PFix = n
        Name = .GetFileName(FN) & " (" & PFix & ")"
      Loop : NF = Path & Name & "\"
        If Not .FolderExists(NF) Then .CreateFolder(NF)
      On Error Resume Next
        .CopyFile F & "*", NF : .CopyFolder F & "*", NF
      On Error Goto 0
      If C = 3 Then .DeleteFolder Mid(F, 1, Len(F) - 1)
    End If
  Loop : TF.Close
End With