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

[KarS]

Flasher,
- удалил в 65 строке всё, начиная с двоеточия - появляется ошибка:
picture
- опробовал рекомендацию из поста - вроде заработало нормально, без удаления части кода в строке 65.

[Flasher]

KarS
1. Что-то лишнего удалили. Create — не переменная. 65-ю строку всего-то надо было привести к 'Loop Until List.AtEndOfStream'.
2. Посмотрел код — оказалось, нужно несколько мелких правок.
[cut="Новый вариант:"]

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

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

[/cut]

[KarS]

Flasher, спасибо.
Код работает хорошо.
В этом варианте у меня работает нормально и без привязки Ctrl+Alt+Shift+R к 540/cm_RereadSource

Надеялся, может появиться "Ключ для смены места счётчика в начале или в конце имени файла", но видимо, не в этот раз
Всё равно, спасибо.

[Flasher]

KarS
Пож-та. Привязка нужна, если хочется более быстрого проявления результата.
Сам по себе момент со счётчиком спереди специфический, а догружать в цикл ряд условий в угоду скорости не хотелось.

[KarS]

Если автор говорит, что привязка нужна - значит сделаем
Согласен, везде нужен баланс.

[sania.mamaeff]

Flasher
Привет. Мне хочется копировать файлы по папкам с переименованием файлов. Я так понимаю этот скрипт делает именно это. Но я не могу понять как им пользоваться. Прочитал памятку для новичков, не помогает. Можно ли где-то посмотреть просто понятное видео в котором объясняют просто и понято как использовать скрипты?

[Avada]

sania.mamaeff
Информация о правилах пользования скриптами в существующей уже, мягко говоря, не первый год памятке изложена вполне просто и понятно, никакие видео в дополнение к ней не предусмотрены и не планируются. Придётся разбираться с тем, что написано.
А имя того, к кому вы обращаетесь, переносится в пост просто щелчком по его нику в левой части подходящего сообщения. Исправлено.

[Flasher]

Мне хочется копировать файлы по папкам с переименованием файлов.

Весьма расплывчатое пожелание.

Я так понимаю этот скрипт делает именно это.

Ряд здешних скриптов (для новичков актуален с TCKB) копируют файлы в заданную папку/панель, переименование является лишь потенциальным действием. По остальному добавить нечего.

А имя того, к кому вы обращаетесь

Поправочка — ник.

[Avada]

sania.mamaeff
К сказанному добавлю, что есть случаи копирования с переименованием, когда в скриптах вообще нет надобности. Разверните кнопкой "Опции" диалог копирования и посмотрите, что там ещё есть (в том числе в выпадающем списке "Настройки перезаписи"). А сейчас по вашему изложению задачи совершенно невозможно понять, что же нужно на самом деле.

[Singlelol]

Доброго времени суток! Пролистал много сообщений но не смог найти.

Есть набор папок содержащих файлы *.jpg.
Требуется скопировать с переименованием папок формат [a-z0-9] по счетчику.
И (вывести/сохранить в файл) пути [старый путь/имя файла] [/iblock/новый путь/имя файла].
Видел и групповое переименование и копирование, но с сохранением старых и новых путей не нашел. Если я слепой, то ткните пальцем.

[Avada]

Singlelol
Тыкать пальцем пока некуда, потому как лично я, например, вообще ничего из запроса не понял. Ни про пути, ни про переименование папок по счётчику, ни про то, какое отношение эти выведения/сохранения имеют к групповому переименованию.

[Singlelol]

Ок. На примере. \Kids Smartwatch CNE-KW21BL Blue\orig.jpg переносится в a01\orig.jpg
и выводится/сохраняются в файл пути в формате \Kids Smartwatch CNE-KW21BL Blue\orig.jpg /iblock/a01/orig.jpg

[Avada]

Singlelol
Ещё раз: при чём тут групповое переименование? И что означает "выводится"? Где?

[Singlelol]

Скорее всего не причем переименование, т.к. сами файлы не переименовываются, а создаются новые каталоги.
Выводится или на экран окном или в буфер обмена. Так его можно будет вставить в файл.

[Flasher]

Singlelol
С тредом явно мимо клуба.
Нужно jpg из всех папок скопировать в одну общую?
В выводе косая черта в разные стороны целенаправлено задана?