всем встать!

'============================================================================== 
' Переименование выделенных файлов по файлу, содержащему новые имена 
' 
' В качестве параметров указать: 
' %L {полный путь к файлу, содержащему новые имена} 
'============================================================================== 
Option Explicit 
If WScript.Arguments.Count < 2 Then 
  MsgBox "Указаны не все параметры", _ 
         vbOKOnly + vbExclamation, _ 
         "Переименование файлов" 
  WScript.Quit 
End If 
Dim FSO, OTF1, OTF2, FilePath, NewName, oFile 
Set FSO = CreateObject("Scripting.FileSystemObject") 
Set OTF1 = FSO.OpenTextFile(WScript.Arguments(0), 1) 
Set OTF2 = FSO.OpenTextFile(WScript.Arguments(1), 1) 

Do While (Not OTF1.AtEndOfStream) and (Not OTF2.AtEndOfStream) 
  FilePath  = OTF1.ReadLine 
  NewName   = FSO.GetBaseName(OTF2.ReadLine) 
  If FSO.FileExists(FilePath) Then 
    Set oFile = FSO.GetFile(FilePath) 
    oFile.Name = NewName & "." & FSO.GetExtensionName(FilePath) 
  End If 
Loop 

OTF1.Close 
OTF2.Close 
Set oFile = Nothing 
Set OTF1  = Nothing 
Set OTF2  = Nothing 
Set FSO   = Nothing 
WScript.Quit