mrmoto
|
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 |
|
|