View previous topic :: View next topic |
Author |
Message |
mythblu84
Joined: 06 Apr 2012 Posts: 3
|
(Separately) Posted: Fri Apr 06, 2012 09:38 Post subject: Копирование массива каталогов с одинаковыми именами |
|
|
Добрый День.
Как осуществить копирование большого количества найденных каталогов выведенных на панель. Без слияния каталогов с одинаковыми именами.
Пример
После поиска на панели есть каталоги
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 папку |
|
Back to top |
|
 |
MVV

Joined: 15 Oct 2009 Posts: 4815 Location: Ростов-Дон
|
|
Back to top |
|
 |
Flasher

Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Fri Apr 06, 2012 10:32 Post subject: |
|
|
mythblu84
Скрипт несложный. Пока времени нет. Может, вечером, если не опередят.
MVV
Это подойдёт, только если совпавшие каталоги не требуется хранить в одной директории на одной глубине. |
|
Back to top |
|
 |
mythblu84
Joined: 06 Apr 2012 Posts: 3
|
(Separately) Posted: Fri Apr 06, 2012 11:16 Post subject: |
|
|
MVV wrote: | Поможет плагин типа TreeCopyPlus. Ставишь его, выделяешь файлы, жмешь Alt+F5 (упаковать) и выбираешь его. Он копирует с сохранением структуры. |
Не он мне копирует всю структуру получается
c:\all\c\xx\1\
c:\all\c\xx\2\
c:\all\c\zz\1\ и тд |
|
Back to top |
|
 |
Flasher

Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Fri Apr 06, 2012 16:03 Post subject: |
|
|
mythblu84
Там же в настройках задаётся число отсекаемых компонентов в началах путей.
Обещанное:
Code: | '=============================================================
' Копировать выделенные папки с переименованием при совпадении
' Параметры: %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 |
|
|
Back to top |
|
 |
|