Single Post - Копирование с переименовыванием по счетчику

Новый вариант:

Code:

'••••••••••••••••••••••••••••••••••••••••• VBS ••••••••••••••••••••••••••••••••••••••••
' Cоздать указанное число копий/пустышек для каждого выбранного элемента
' с добавлением счётчика перед именами, начиная с самого крайнего номера

' Условие: привязка Ctrl+Alt+Shift+R к 540/cm_RereadSource

' Параметры: %WL "<путь назначения>" <число копий> <вставка после №> <расширение файла>
' Если указан 5-й параметр, то создаваться будут пустые элементы
' Ключ для смены начала счётчика с единицы на двойку: /2

' Примеры: %WL "%P" /2 | %WL "%T" "" _ | %WL "%P" 5 . | %WL "%T" 1 "" txt
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••• Автор: Flasher © •••

Option Explicit: Dim C, Two, List, Cn, Path, Count, Px, Ext, ShA, FSO, Rgx,_
F, FN, Test, Ex, BN, Max, i, n, M, Items, iP, FF, Exist, FP, Cnt, Num, Check

With WSH.Arguments
C = .UnNamed.Count : Two = .Named.Exists("2") : If C = 0 Then WSH.Quit
If C = 1 Then MsgBox "Должно быть указано не менее 2-х параметров!", 48 : WSH.Quit
List = .Item(0) : Path = .Item(1) : If C > 2 Then Count = .Item(2)
If Count = "" Then Count = Trim(InputBox(String(4, vbLf) & "Введите число создаваемых копий"&_
vbLf & "для каждого выбранного элемента:", Space(13) & "Создание копий выбранных элементов"))
If Not IsNumeric(Count) Then WSH.Quit : End If : If C > 3 Then Px = .Item(3)
If C = 5 Then If .Item(4) <> "" Then Ext = "." & .Item(4) End If
End With : Set Rgx = New RegExp : Rgx.Pattern = "^((0*)\d+)(\D.*)?$"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ShA = CreateObject("Shell.Application")
Set List = FSO.OpenTextFile(List,,,-1)

Do : F = Trim(List.ReadLine)
FN = FSO.GetFileName(F)
If FSO.FolderExists(F) Then
Test = 1 : BN = FN
ElseIf FSO.FileExists(F) Then
Test = 0 : BN = FSO.GetBaseName(FN)
Ex = FSO.GetExtensionName(F) : If C < 5 And Len(Ex) Then Ext = "." & Ex
End If : Max = 0 : If C = 5 Then FN = FSO.GetBaseName(F) & Ext
FP = FSO.BuildPath(Path, FN) : Exist = (FSO.FolderExists(FP) Or FSO.FileExists(FP))
If Rgx.Test(BN) Then
M = Rgx.Execute(BN)(0).SubMatches(0) : Max = M : BN = Right(BN, Len(BN) - Len(M))
ElseIf Left(BN, Len(Px)) <> Px Then
n = 1
For i = 1 To Len(Px)
If Left(Px, i) = Left(BN, i) Then n = i
Next : BN = Mid(Px, n) & BN
End If : Set Items = ShA.NameSpace(Path).Items
Items.Filter 73952, "*" & BN & Ext
For Each i in Items
iP = i.Path : If Test = 0 Then FF = FSO.GetBaseName(iP) Else FF = FSO.GetFileName(iP)
If Replace(Ext, ".", "") = FSO.GetExtensionName(iP) Then _
If Rgx.Test(FF) Then Set FN = Rgx.Execute(FF)(0) : M = FN.SubMatches(0) :_
If CLng(M) > CLng(Max) And FN.SubMatches(1) = Left(FN.SubMatches(1), Len(BN & Px)) Then Max = M
Next : Cnt = Count : If Not Exist Then Create Test, F, FP, Ext : Cnt = Count - 1
If Cnt Then
For i = 1 To Cnt
If Rgx.Execute(Max)(0).SubMatches(1) = "" Then
Max = Max + 1
Else
If Len(Max + 1) >= Len(Max) Then Max = Max + 1 Else _
Max = String(Len(Max) - Len(Max + 1), "0") & Max + 1
End If : If Two And Max < 2 Then Max = 2
FP = FSO.BuildPath(Path, Max & BN) & Ext
Create Test, F, FP, Ext
Next
End If
Loop Until List.AtEndOfStream : CreateObject("WScript.Shell").SendKeys "^+R"

Sub Create(T, Fl, PF, E)
If T Then
If C = 5 Then FSO.CreateFolder PF Else FSO.GetFolder(Fl).Copy PF, 0
Else
If C = 5 Then FSO.CreateTextFile PF Else FSO.CopyFile Fl, PF, 0
End if
End Sub