'••••••••••••••••••••••••••••••••••••••••• 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