Total Commander

Flasher
Поставил курсор на корневую 1111...

Скрипт сработал при чёткой структуре папок типа:
C:\temp\11111111111\2\pic\0001.jpg

Но в реальности папки могут называться совершенно по разному. Неизменно только их положение относительно друг друга и название последней папки "pic".

Тоесть при структуре типа
C:\temporary\oneoneone\two\pic\0001.jpg
скрипт уже не работает.

Полагаю я некорректно расписал пример. Вот корректный.
...XXX\Z\pic\0001.jpg
XXX - произвольный путь.

У вас в скрипте Z принимается за номер, но это может быть и "1", и "2", и "ff", и "jp71" и т.д.

Petr_Ch писал(а):У вас в скрипте Z принимается за номер, но это может быть и "1", и "2", и "ff", и "jp71" и т.д.

Естественно, об этом надо было писать заранее, потому что подтверждением очевидности постоянства имён папок является нумерация. В названии чётко написано "..\№\pic\ в корень выбранной папки с переименованием их по шаблону №_имя". Другими словами, поставленную ранее задачу я выполнил.
В новой достаточно убрать 16 и 21 строки.

Petr_Ch писал(а):Batya
Выделять пробовал самые разные папки. Не помогает.

Хм... Да, были косяки.
Переписал скрипт полностью:

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

'====================================================================== 
' Для каждой папки из файла-списка перемещаются и переименовываются 
' вложенные файлы - {Имя выделенной папки}_{Имя файла}.{Расширение} 
' 
' Параметры: 
' {файл-список} 
' 
' Пример параметров при вызове из TC: 
' %L 
'====================================================================== 
Option Explicit 
Dim EXT
Set EXT = CreateObject("Scripting.Dictionary")
'========== Изменяемые параметры ======================================
Const BasePath = "C:\Temp" 'Пусть для перемещения файлов
'Массив расширений обрабатываемых файлов
EXT.Add "jpg", ""
EXT.Add "tif", ""
'======================================================================

Dim FSO, FF, F, SF 

With WScript 
  If .Arguments.Count = 0 Then 
    MsgBox "Не заданы параметры!", vbOKOnly + vbCritical, "Перемещение вложенных файлов" 
    .Quit 
  End If 
  FF = .Arguments(0) 
End With 

Set FSO = CreateObject("Scripting.FileSystemObject") 

With FSO.OpenTextFile(FF, 1) 
  Do While Not .AtEndOfStream 
    F = Trim(.ReadLine) 
    If F <> "" Then 
      If FSO.FolderExists(F) Then 
        On Error Resume Next 
        MoveFromFolder FSO.GetFolder(F), F 
        Err.Clear 
        On Error GoTo 0 
      End If 
    End If 
  Loop 
  .Close 
End With 

Set FSO = Nothing 
Set EXT = Nothing 
WScript.Quit 

Sub MoveFromFolder(pSubFolder, pFolder) 
  Dim lF 
  For Each lF In pSubFolder.Files 
    MoveFile lF, pFolder 
  Next 
  For Each lF In pSubFolder.SubFolders 
    MoveFromFolder lF, pFolder 
  Next 
End Sub 

Sub MoveFile(pFile, pFolder) 
  Dim lF, lE 
  lF = BasePath & FSO.GetBaseName(pFolder) & "_" & pFile.Name 
  lE = LCase(FSO.GetExtensionName(pFile.Path)) 
  If EXT.Exists(lE) Then FSO.MoveFile pFile.Path, lF 
End Sub

Выделять нужно папки. Уровень вложенности у папок может быть любой. Новые имена файлов получают приставку именно от имён выделенных папок (если не удобно, могу переделать).

Batya

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

Только я заменил "_" на "#".
Вот зачем:

Провёл я, предположим, мою гипотетическую обработку и снова собраны у меня все файлы рядом с папками, от которых к ним дописаны имена.
Пример:
c:\temp\XXXX\out
c:\temp\YYYY\out
c:\temp\XXXX#01.jpg
c:\temp\XXXX#02_add.jpg
c:\temp\XXXX#03.jpg
c:\temp\YYYY#01.jpg
c:\temp\YYYY#02.jpg
c:\temp\YYYY#03.jpg

Теперь эти файлы надо вложить в папки
c:\temp\XXXX\out\
c:\temp\YYYY\out\
Причём файлы кладутся в те папки, с которыми имена до знака "#" совпадают с названием папки. И именно в подпапку out.

В итоге файлы должны оказаться:
c:\temp\XXXX_01\out\XXXX#01.jpg
c:\temp\XXXX_01\out\XXXX#02_add.jpg
c:\temp\XXXX_01\out\XXXX#03.jpg
c:\temp\YYYY_01\out\YYYY#01.jpg
c:\temp\YYYY_01\out\YYYY#02.jpg
c:\temp\YYYY_01\out\YYYY#03.jpg

Можно такое реализовать?

Petr_Ch писал(а):c:\temp\XXXX\out
c:\temp\YYYY\out

Petr_Ch писал(а):c:\temp\XXXX_01\out\XXXX#01.jpg

Не понял. Папки XXXX и YYYY должны при этом переименовываться?

Petr_Ch
>

Flasher писал(а):В новой достаточно убрать 16 и 21 строки.

Неужели не работает?

Petr_Ch писал(а):Причём файлы кладутся в те папки, с которыми имена до знака "#" совпадают с названием папки. И именно в подпапку out.

Нечто похожее есть - Создание дерева папок согласно разделителя в имени файла\папки.
Только поменяй строку:

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

  If Rank(Mode, 2) = 2 Then NameArr(r) = BaseName

на

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

  If Rank(Mode, 2) = 2 Then NameArr(r) = "out" & BaseName

Параметры вызова:
%L C:\Temp 22 "#"

Выделять нужно файлы.

Flasher
Удаление строчек не помогло((

Batya
Спасибо за второй скрипт. То что надо.

И последний штрих.
Можете к нему добавить функцию автоматического переименования уже перенесенных файлов по счётчику? Чтобы в в каждой папке файлы начинались с 0001, 0002, 0003 и т.д. ?
Это уже умеет делать ваш скрипт, но незнаю как его со здешним скриптом подружить.

Petr_Ch писал(а):Удаление строчек не помогло((

Petr_Ch писал(а):C:\temporary\oneoneone\two\pic\0001.jpg
скрипт уже не работает.

Убеждаемся, что в папке temporary ещё нет папки с новым именем, ставим курсор на oneoneone, потом уже нажимаем кнопку.

Petr_Ch писал(а):Можете к нему добавить функцию автоматического переименования уже перенесенных файлов по счётчику?

Ко второму скрипту, т.е. к обратному переносу?

Petr_Ch писал(а):Чтобы в в каждой папке файлы начинались с 0001, 0002, 0003 и т.д. ?

Именно, начинались? Количество цифр в приставке 4?

Batya
Не "начинались", а вообще были бы названы по счётчику. Тоесть приобрели бы конечный вид из четырех цифр. Пример:
0001.jpg
0002.jpg
0003.jpg
0004.jpg

И в каждой папке счётчик начинается с еденицы (0001).

Petr_Ch
А папка out перед запуском скрипта пустая? Т.е. нужно переносимые файлы именовать c 0001 и далее?
Или там уже что-то лежит, и нужно начинать именовать переносимые файлы после уже существующих?

Batya
Да. Все ауты пустые.

Petr_Ch
Не хочется приводить весь немного переделанный скрипт под твои частные задачи.
Итак, частями...
1. Объявляем ещё одну переменную j:

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

Dim Path, Name, FullPath, SepPos, SepPosArr, IsFolder, BaseName, j

2. После For Each F In Split(FSO.OpenTextFile(FileList).ReadAll, vbNewLine) пишем

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

  j = j + 1

3. Вместо

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

  If Rank(Mode, 2) = 2 Then NameArr(r) = "out\" & BaseName

пишем

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

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

Сам не тестировал, но должно быть всё ОК.
По-хорошему, можно ещё несколько строк проверок и улучшалок добавить, но ты, скорее всего, никогда и не попадёшь в проблемный вариант (например, количество файлов больше 9999).

Batya
Работает, но нумерация идёт сквозной.
Тоесть в одной папке она закончилась на 0007, в следующем ауте продолжается 0008, 0009 и т.д.
А надо чтобы в каждом с 0001 начиналась.

Total Commander

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