'======================================================================
' Создание нескольких копий каждого файла из файла-списка
'
' Параметры:
' {файл-список} {целевая папка} {количество}
'
' Пример параметров при вызове из 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
' Cоздать указанное число копий для каждого выделенного элемента
' Параметры: %L "<путь назначения>"
' Пример: %L "%P"
'===============================================================
If WScript.Arguments.Count = 0 Then WScript.Quit
L = vbNewLine
Count = InputBox(L&L&L&L&"Введите число создаваемых копий" & L &_
"для каждого элемента списка :", " Создание копий выделенных элементов")
If IsNumeric(Count) Then
For Each F in Split(CreateObject("Scripting.FileSystemObject")._
OpenTextFile(WScript.Arguments(0)).ReadAll, L)
If F > vbNullString Then
For n = 1 To Abs(Count)
CreateObject("Shell.Application").NameSpace(WScript.Arguments(1)).CopyHere F, 8
Next
End If
Next
End If
Здравствуйте!
Есть такая проблема: производится перемещение файлов с разных фотоаппаратов в одну папку на компьютере. Необходимо, чтобы в папке файлы именовались просто порядковыми номерами, т.е. 01.jpg, 02.jpg, ...,10.jpg и т.д., а при добавлении файлов в эту папку, нумерация продолжалась. Пока всё это делается вручную: перемесить-выделить новые файлы-групповое переименование с установкой начального значения счетчика. Можно ли автоматизировать этот процесс? Буду благодарен всем откликнувшимся.
Спасибо, что не оставили без внимания, но перед тем как задать вопрос я просмотрел все темы в разделе автоматизации, а так же пробовал поиск по словам "перемещение" и "переименование". К сожалению ничего подходящего не нашел . Помогите ссылочкой, пожалуйста.
Ребята, нужна помощь. Скажите, можно ли написать bat-файл, который будет находить на всех дисках (С, D, E, *) файлы скажем с расширением *.txt и копировать их в папку D:\1, и при одинаковом имени файла не заменять его, а добавлять к названию цифру. (1.txt, 1(1).txt, 1(2).txt, 1(3).txt,.....).
Читал, пробовал делать, но или в голове не так что-то или руки кривые. Помогите с файликом, пожалуйста.
obse
Заданный вопрос ни к подфоруму "Общие вопросы", ни уж тем более к теме Ошибка ввода/вывода - как создать список нечитающихся файлов не имеет ни малейшего отношения. Читаем правила форума и учимся пользоваться поиском.
Сообщение перенесено в более подходящее место. А тут уж специалисты по автоматизации выскажут своё мнение.
Даже самая богатая фантазия
Не представит себе наши безобразия.
. Помогите ссылочкой, пожалуйста.