View previous topic :: View next topic |
Author |
Message |
mrmoto
Joined: 04 Jun 2010 Posts: 5
|
(Separately) Posted: Fri Jun 04, 2010 01:47 Post subject: Перемещение файлов в соотв-щие папки и их переименование |
|
|
Уважаемые товарищи, подскажите пожалуйста, как подправить код Бати, чтобы не просто перемещать файлы в соответствующие их именам каталоги, т.е. A-123-12A_kartinka.jpg в каталог A-123-12A
B-234-34B_kartinka.jpg в каталог B-234-34B
а cделать тоже самое в более глубоких поддиректориях и с последующим переименованием, т.е. файлами из:
jpeg/титул_001.jpg, оглавление_001.jpg, страница_001.jpg
. . . . титул_002.jpg, оглавление_002.jpg, страница_002.jpg
. . . .
. . . . титул_300.jpg, оглавление_300.jpg, страница_300.jpg
нужно заменить файлы в директории:
тираж/проект_001/Autoplay/Image/титул.jpg, оглавление.jpg, страница.jpg
. . . . .
. . . . . проект_300/ . . .
Но имена файлов нужно оставить прежними:
титул.jpg, оглавление.jpg, страница.jpg
Code: | Code:
'=====================================================================
' Перемещение выделенных файлов в соответствующие им папки на
' противоположной панели TC
' Папка соответствует файлу, если ее имя является началом имени файла
' Параметры вызова из TC:
' %L "%T"
'=====================================================================
Option Explicit
Dim Title, Mess, FSO, ListF, List, Target, Fold, File, Name
' Проверяем параметры
Title = "Внимание!"
If WScript.Arguments.Count < 2 Then
Mess = "Неправильно указаны параметры!"
MessQuit
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
ListF = WScript.Arguments(0)
Target = WScript.Arguments(1)
If Not FSO.FileExists(ListF) Then
Mess = "Неправильно указан файл-список обрабатываемых файлов!"
MessQuit
End If
If Not FSO.FolderExists(Target) Then
Mess = "Неправильно указана целевая папка!"
MessQuit
End If
List = Split(FSO.OpenTextFile(ListF).ReadAll, vbNewLine)
For Each Fold In FSO.GetFolder(Target).SubFolders
Name = Fold.Name
For Each File In List
If FSO.FileExists(File) Then 'Проверяем, не перемещен ли он уже
If LCase(Name) = LCase(Left(FSO.GetBaseName(File), Len(Name))) Then
FSO.CopyFile File, Fold & "\", True
FSO.DeleteFile File
End If
End If
Next
Next
Quit
Sub MessQuit
MsgBox Mess, vbOKOnly + vbError, Title
Quit
End Sub
Sub Quit
Set FSO = Nothing
Wscript.Quit
End Sub |
|
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2218 Location: Москва, Россия
|
(Separately) Posted: Fri Jun 04, 2010 09:32 Post subject: |
|
|
mrmoto
Выполняем в 2 этапа:
1. Переименование файлов.
Выделяем файлы и запускаем Инструмент группового переименования. Применяем шаблон имени "Тираж&Проект[N-4-]&Autoplay&Image&[N1--5]" (шаблон расширения без изменений - "[E]"). Здесь вместо символа "&" можно использовать любой, который не встречается в именах файлов.
2. Перемещение файлов.
Вначале создаем кнопку для этого скрипта с параметрами
Теперь на противопложной панели TC открываем папку, где должна лежать папка "Тираж", затем выделяем файлы и нажимаем кнопку. _________________ Нет, я не сплю. Я просто медленно моргаю. |
|
Back to top |
|
|
mrmoto
Joined: 04 Jun 2010 Posts: 5
|
(Separately) Posted: Fri Jun 04, 2010 23:28 Post subject: |
|
|
Не могу уразуметь, выдаёт ошибку в строке 210 символ 3: несоответствие типа 'UBound'.
Этот скрипт случайно не создает директорию с подкаталогами исходя из имени файла Тираж&Проект_001&Autoplay&Image&титул.txt?
У меня-то задача перемещать файлы в уже существующие папки Проект_001/Autoplay/Image/ . . .
. . .
Проект_300/Autoplay/Image/ . . . |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2218 Location: Москва, Россия
|
(Separately) Posted: Mon Jun 07, 2010 10:39 Post subject: |
|
|
mrmoto
Прошу прощения. У себя смотрел на другом варианте скрипта, нежели идёт по ссылке.
В скрипте ошибка при работе с количеством параметров меньше 5. Сейчас поправить скрипт не могу - на форуме сейчас запрет на редактирование старых сообщений.
Поправь скрипт у себя. После кода (перед "End If")
Code: | SepPosArr(i) = (S = 1)
Next
|
напиши
Code: | Else
SepPosArr = Array()
|
Либо можно указать пятый параметр - 1. _________________ Нет, я не сплю. Я просто медленно моргаю. |
|
Back to top |
|
|
mrmoto
Joined: 04 Jun 2010 Posts: 5
|
(Separately) Posted: Mon Jun 07, 2010 19:37 Post subject: |
|
|
Честно говоря не получается ни так, ни так.. постоянно выдает ошибку в тех строках, которые заменяю. И с пятым параметром тоже.
Поправь пожалуйста скрипт, когда снимут запрет. |
|
Back to top |
|
|
Flasher
Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Mon Jun 07, 2010 19:41 Post subject: |
|
|
mrmoto wrote: |
Поправь пожалуйста скрипт, когда снимут запрет. | Снятия запрета ждать возможно придётся долго. Проще попросить модератора. |
|
Back to top |
|
|
mrmoto
Joined: 04 Jun 2010 Posts: 5
|
(Separately) Posted: Mon Jun 07, 2010 21:42 Post subject: |
|
|
Я конечно не особо разбираюсь в скриптах, но нельзя ли все-таки использовать код, приведенный в первом посте? Он отлично работает и делает почти то что мне нужно - перемещает файл в папку с именем, являющимся началом имени файла:
001_титул.jpg в папку 001 Надо лишь перемещать в более глубокую директорию:001_титул.jpg в папку 001/Autoplay/Image
А переименование - бог с ним, можно сделать груповым переименованием. |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2218 Location: Москва, Россия
|
(Separately) Posted: Wed Jun 09, 2010 11:33 Post subject: |
|
|
mrmoto wrote: | выдает ошибку в тех строках, которые заменяю |
Ничего не надо менять, надо добавить две строки.
Flasher wrote: | Проще попросить модератора. |
Сейчас попросил. _________________ Нет, я не сплю. Я просто медленно моргаю. |
|
Back to top |
|
|
mrmoto
Joined: 04 Jun 2010 Posts: 5
|
(Separately) Posted: Thu Jun 10, 2010 00:23 Post subject: |
|
|
Заработало! Гениально! Спасибо большое! |
|
Back to top |
|
|
|