'======================================================================
' Создание нескольких копий каждого файла из файла-списка
'
' Параметры:
' {файл-список} {целевая папка} {количество}
'
' Пример параметров при вызове из TC:
' %L "%T" 200
'======================================================================
Option Explicit
Dim FSO, FF, F, i, TF, T, Q
With WScript
If .Arguments.Count < 3 Then
MsgBox "Неправильно заданы параметры!", vbOKOnly + vbCritical, "Создание нескольких копий"
.Quit
End If
FF = .Arguments(0)
TF = .Arguments(1)
Set FSO = CreateObject("Scripting.FileSystemObject")
If (Not FSO.FolderExists(TF)) And (TF <> "") Then
MsgBox "Некорректно указана целевая папка!", vbOKOnly + vbCritical, "Создание нескольких копий"
Set FSO = Nothing
.Quit
End If
If TF <> "" Then If Right(TF, 1) <> "\" Then TF = TF & "\"
Q = CInt(.Arguments(2))
End With
With FSO.OpenTextFile(FF, 1)
Do While Not .AtEndOfStream
F = Trim(.ReadLine)
If F <> "" Then
If FSO.FileExists(F) Then
If TF = "" Then T = FSO.GetParentFolderName(F) & "\" Else T = TF
For i = 1 To Q
FSO.CopyFile F, NextName(T & FSO.GetFileName(F))
Next
End If
End If
Loop
.Close
End With
Set FSO = Nothing
WScript.Quit
Function NextName(pPath)
Dim lPath, lName, lExt, li, lAdd
Const lQ = 1 'Минимальное количество цифр в номере
With CreateObject("Scripting.FileSystemObject")
lPath = .GetParentFolderName(pPath)
If lPath <> "" Then lPath = lPath & "\"
lName = .GetBaseName(pPath)
lExt = .GetExtensionName(pPath)
NextName = pPath
Do While .FileExists(NextName) Or .FolderExists(NextName)
li = li + 1
If li < 10^lQ Then
lAdd = Right(String(lQ, "0") & li, lQ)
Else
lAdd = li
End If
NextName = lPath & lName & "(" & lAdd & ")." & lExt
Loop
End With
End Function
|
. Помогите ссылочкой, пожалуйста.