Нужен скрипт "поиск+переименование+перенос"

[Batya]

А надо чтобы в каждом с 0001 начиналась.

Продолжаем преобразования.
Вместо j объявляем другую переменную:

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

Dim Path, Name, FullPath, SepPos, SepPosArr, IsFolder, BaseName, NUM
Set NUM = CreateObject("Scripting.Dictionary")

Строку "j = j + 1" убираем.

Вместо

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

  NameArr(r) = "out" & Right(String(4, "0") & j, 4)

пишем

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

  If NUM.Exists(LCase(Path)) Then NUM((LCase(Path))) = NUM(LCase(Path)) + 1 Else NUM.Add LCase(Path), 1
  NameArr(r) = "out" & Right(String(4, "0") & NUM((LCase(Path))), 4)

[Petr_Ch]

Ура. Всё работает.

Большое спасибо!