Total Commander Forum Index Total Commander
Форум поддержки пользователей Total Commander
Сайты: Все о Total Commander | Totalcmd.net | Ghisler.com | RU.TCKB
 
 RulesRules   SearchSearch   FAQFAQ   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Single Post  Topic: Перемещение файлов в соотв-щие папки и их переименование 
Author Message
mrmoto



PostPosted: Fri Jun 04, 2010 01:47    Post subject: Перемещение файлов в соотв-щие папки и их переименование Reply with quote

Уважаемые товарищи, подскажите пожалуйста, как подправить код Бати, чтобы не просто перемещать файлы в соответствующие их именам каталоги, т.е.
    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
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group