'================================ VBS ================================
' Копировать выбранные папки с переименованием по шаблону [a-z][01-99]
' + Отчёт по шаблону: <исходный относительный путь к файлу> </новый>
' Условие: пустое поле «Путь запуска:»
' Параметры: %WF "<относительный путь назначения>" "имя лога"
' Пример: %WF iblock Log.txt
'=====================================================================
Option Explicit
Dim A, T, Sym, REx, TF, LF, Items, Nm, Fd, n, c, x, F, NP
Set A = WSH.Arguments: If A.Count Then T = A(1) Else WSH.Quit
Sym = Split("a b c d e f g h i j k l m n o p q r s t u v w x y z")
Set REx = New RegExp : REx.Pattern = "([a-z]+)(\d+)"
With CreateObject("Scripting.FileSystemObject")
Set TF = .OpenTextFile(A(0),,,-1)
Set LF = .OpenTextFile(A(2),8,1,-1)
With CreateObject("Shell.Application").NameSpace(.GetAbsolutePathName(""))
.NewFolder T : Set Items = .ParseName(T).GetFolder.Items
End With
Items.Filter 8224, "*"
If Items.Count Then
Set Nm = REx.Execute(Items.Item(Items.Count - 1))(0)
c = Nm.SubMatches(0) : x = Len(c) : c = Asc(c) - 97
n = CInt(Nm.SubMatches(1))
If c = 26 And n = 99 Then x = x + 1
If n < 99 Then n = n + 1 Else n = 1 : c = c + 1
Else c = 0 : n = 1 : x = 1 End If
Set REx = Nothing : Set Items = Nothing
Do: Fd = TF.ReadLine
If Right(Fd, 1) <> "\" Then Exit Do
NP = .BuildPath(T, String(x, Sym(c)) & Right("0" & n, 2))
.GetFolder(Fd).Copy NP : If c = 26 And n = 99 Then x = x + 1
If n < 99 Then n = n + 1 Else n = 1 : c = c + 1
For Each F In .GetFolder(Fd).Files
LF.WriteLine Fd & F.Name & " /" & Replace(NP, "\", "/") & "/" & F.Name
Next
Loop Until TF.AtEndOfStream : TF.Close : LF.Close
End With
CreateObject("WScript.Shell").Popup " Выполнено!", 2, " Копирование каталогов ", 4160 |