View previous topic :: View next topic |
Author |
Message |
Batya
Joined: 15 Dec 2004 Posts: 2220 Location: Москва, Россия
|
(Separately) Posted: Fri Oct 21, 2011 10:50 Post subject: |
|
|
Мои 5 копеек:
Code: | '======================================================================
' Создание нескольких копий каждого файла из файла-списка
'
' Параметры:
' {файл-список} {целевая папка} {количество}
'
' Пример параметров при вызове из 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
|
_________________ Нет, я не сплю. Я просто медленно моргаю. |
|
Back to top |
|
|
Flasher
Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
|
Back to top |
|
|
Avada
Joined: 01 Aug 2008 Posts: 10284 Location: Россия, Саратов
|
(Separately) Posted: Fri Oct 21, 2011 13:05 Post subject: |
|
|
Объединяю тему с уже существующей. _________________ Даже самая богатая фантазия
Не представит себе наши безобразия. |
|
Back to top |
|
|
DeathStalker
Joined: 01 Sep 2006 Posts: 331 Location: Санкт-Петербург
|
(Separately) Posted: Fri Oct 21, 2011 17:03 Post subject: |
|
|
Всем спасибо за помощь. _________________ Гугль - это Матрица, чем меньше его спрашивать, тем слабее будут машины во время Великой Битвы
TC10.00b6 x86 Windows 10 x64 (Windows 7 x64) |
|
Back to top |
|
|
Flasher
Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Fri Oct 21, 2011 17:52 Post subject: |
|
|
Пусть ещё облегчённый вариант будет:
Code: | ' 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 |
|
|
Back to top |
|
|
Serrg
Joined: 25 Dec 2011 Posts: 3
|
(Separately) Posted: Sun Dec 25, 2011 17:21 Post subject: Перемещение файлов с переименованием (нумерацией) |
|
|
Здравствуйте!
Есть такая проблема: производится перемещение файлов с разных фотоаппаратов в одну папку на компьютере. Необходимо, чтобы в папке файлы именовались просто порядковыми номерами, т.е. 01.jpg, 02.jpg, ...,10.jpg и т.д., а при добавлении файлов в эту папку, нумерация продолжалась. Пока всё это делается вручную: перемесить-выделить новые файлы-групповое переименование с установкой начального значения счетчика. Можно ли автоматизировать этот процесс? Буду благодарен всем откликнувшимся.
! | Моторокер: | Тема объединена с текущей. | |
|
Back to top |
|
|
Tol!k
Joined: 01 Apr 2008 Posts: 1727 Location: Арзамас
|
(Separately) Posted: Sun Dec 25, 2011 18:05 Post subject: |
|
|
Было. Пользуйтесь поиском. |
|
Back to top |
|
|
Serrg
Joined: 25 Dec 2011 Posts: 3
|
(Separately) Posted: Sun Dec 25, 2011 18:28 Post subject: |
|
|
Спасибо, что не оставили без внимания, но перед тем как задать вопрос я просмотрел все темы в разделе автоматизации, а так же пробовал поиск по словам "перемещение" и "переименование". К сожалению ничего подходящего не нашел . Помогите ссылочкой, пожалуйста. |
|
Back to top |
|
|
Tol!k
Joined: 01 Apr 2008 Posts: 1727 Location: Арзамас
|
(Separately) Posted: Sun Dec 25, 2011 19:32 Post subject: |
|
|
к http://forum.wincmd.ru/viewpost.php?p=62914 добавил перемещение
Code: | @echo off &setlocal enableextensions &chcp 1251 >nul
rem Копирование файлов и папок с переименованием по счётчику
rem Параметры: %L "D:\куда\" "Приставка_"
rem %L "%T" "" -m
rem -m — удалять источник
rem Автор: Tol!k
set "trg=%~2" &set "pref=%~3"
if "%~4"=="-m" set "move=Yes"
for /f "usebackq delims=" %%f in ("%~1") do call :p "%%f"
goto :eof
:p
set "name=%~1" &set "ext=%~x1"
set /a n=0
call :loop 1000 &set /a n-=1000
call :loop 100 &set /a n-=100
call :loop 10 &set /a n-=10
call :loop 1
title "%new%"
if "%name:~-1%"=="\" (
xcopy "%name%*" "%trg%\%new%" /i /e /k/r/h >nul &&if "%move%"=="Yes" rd /s /q %1
) else (
echo f| xcopy %1 "%trg%\%new%" /k/r/h >nul &&if "%move%"=="Yes" del /f /q %1
)
goto :eof
:loop
if "%n%"=="9999" (
title STOP
echo 9999 единиц в месте назначения,
echo недостаточно разрядности счётчика.
pause >nul &exit /b 9
)
set /a n+=%1
set "e=000%n%"
set "e=%e:~-4%"
set "new=%pref%%e%%ext%"
if exist "%trg%\%new%" call :loop %1
goto :eof
|
|
|
Back to top |
|
|
Tol!k
Joined: 01 Apr 2008 Posts: 1727 Location: Арзамас
|
|
Back to top |
|
|
Flasher
Joined: 06 Nov 2009 Posts: 14229 Location: Москва
|
(Separately) Posted: Sun Dec 25, 2011 21:42 Post subject: |
|
|
Serrg
А нумеровать нужно сразу или только при совпадении? |
|
Back to top |
|
|
Serrg
Joined: 25 Dec 2011 Posts: 3
|
(Separately) Posted: Mon Dec 26, 2011 03:48 Post subject: |
|
|
Tol!k
Большущее спасибо за помощь - то что надо!
Flasher
Совпадений не должно быть в принципе, т.к. в фотоаппаратах файлы именуются по другому (IMG0001.jpg, P0001.jpg и т. п.). |
|
Back to top |
|
|
Tol!k
Joined: 01 Apr 2008 Posts: 1727 Location: Арзамас
|
(Separately) Posted: Fri Apr 13, 2012 20:33 Post subject: |
|
|
к http://forum.wincmd.ru/viewpost.php?p=62933
добавил третий параметр — кол-во разрядов в номере (по умолч. 3)
Code: | @echo off &setlocal enableextensions &chcp 1251 >nul
rem Копирование файлов и папок с добавлением номера
rem Параметры: "%L" "d:\куда\" 3
rem Автор: Tol!k
rem http://forum.wincmd.ru/viewpost.php?p=91443
if not "%~3"=="" (set "#=%~3") else set "#=3"
setlocal enabledelayedexpansion
for /l %%i in (2,1,%#%) do (set "min=0!min!" &set "max=9!max!")
endlocal &set "min=0%min%" &set "max=9%max%"
set "trg=%~2"
for /f "delims=" %%f in ('type "%~1"') do call :p "%%f" "%%f."
goto :eof
:p
set "pre=%~n1"
if "%pre%"=="" set "pre=%~n2"
set "name=%~1" &set "ext=%~x1"
set /a n=0 &goto :%min%
:0000000000
:000000000
call :loop 100000000 &set /a n-=100000000
:00000000
call :loop 10000000 &set /a n-=10000000
:0000000
call :loop 1000000 &set /a n-=1000000
:000000
call :loop 100000 &set /a n-=100000
:00000
call :loop 10000 &set /a n-=10000
:0000
call :loop 1000 &set /a n-=1000
:000
call :loop 100 &set /a n-=100
:00
call :loop 10 &set /a n-=10
:0
call :loop 1
title "%new%"
if "%name:~-1%"=="\" (
xcopy "%name%*" "%trg%\%new%" /i /e /k/r/h >nul
) else (
echo f| xcopy "%name%" "%trg%\%new%" /k/r/h >nul
)
goto :eof
:loop
if "%n%"=="%max%" (
echo %max% единиц в месте назначения,
echo недостаточно разрядности счётчика.
title STOP &pause >nul &exit /b 9
)
set /a n+=%1
setlocal enabledelayedexpansion
set "e=%min%%n%" &set "e=!e:~-%#%!"
endlocal &set "e=%e%"
set "new=%pre%_%e%%ext%"
if exist "%trg%\%new%" goto :loop
goto :eof
|
|
|
Back to top |
|
|
obse
Joined: 30 Jul 2012 Posts: 3
|
(Separately) Posted: Mon Jul 30, 2012 16:34 Post subject: |
|
|
Ребята, нужна помощь. Скажите, можно ли написать bat-файл, который будет находить на всех дисках (С, D, E, *) файлы скажем с расширением *.txt и копировать их в папку D:\1, и при одинаковом имени файла не заменять его, а добавлять к названию цифру. (1.txt, 1(1).txt, 1(2).txt, 1(3).txt,.....).
Читал, пробовал делать, но или в голове не так что-то или руки кривые. Помогите с файликом, пожалуйста. |
|
Back to top |
|
|
Avada
Joined: 01 Aug 2008 Posts: 10284 Location: Россия, Саратов
|
(Separately) Posted: Mon Jul 30, 2012 17:15 Post subject: |
|
|
obse
Заданный вопрос ни к подфоруму "Общие вопросы", ни уж тем более к теме Ошибка ввода/вывода - как создать список нечитающихся файлов не имеет ни малейшего отношения. Читаем правила форума и учимся пользоваться поиском.
Сообщение перенесено в более подходящее место. А тут уж специалисты по автоматизации выскажут своё мнение. _________________ Даже самая богатая фантазия
Не представит себе наши безобразия. |
|
Back to top |
|
|
|