Модераторы: Avada, CaptainFlint, Nik, d-view, Моторокер
Скрипт удаляет оригинальный файл\папку, т.е. переименовывает исходную.. а хотелось бы, что бы оригинальный файл оставался, а рядом создавался "бэкап"Batya писал(а):Копирование выделенных файлов\папок с добавлением в начало и конец нового имени определённого текста
Вы, возможно, что-то путаете. Вот этот скрипт выполняет "Переименование выделенных файлов\папок". А вот этот скрипт выполняет "Копирование выделенных файлов\папок".HA3APET писал(а):Скрипт удаляет оригинальный файл\папку, т.е. переименовывает исходную.. а хотелось бы, что бы оригинальный файл оставался, а рядом создавался "бэкап"
Код: Выделить всё
'=======================================================================
' Копировать с переименованием по счётчику и добавочным расширением
' Параметры: %WL "<путь получателя>" <вставка перед №> <доп. расширение>
'=======================================================================
With WScript.Arguments
C = .Count : If C = 0 Then WScript.Quit
If C <> 4 Then MsgBox "Следует указать 4 параметра!", 48,_
Space(12) & "Ошибка вводных данных" : WScript.Quit : End If
List = .Item(0) : P = .Item(1) : S1 = .Item(2) : S2 = .Item(3)
End With
With CreateObject("Scripting.FileSystemObject")
Path = .BuildPath(P, "\")
Set List = .OpenTextFile(List,,,-1)
Do : F = List.ReadLine
If .FileExists(F) Then
BN = .GetBaseName(F) : Ext = "." & .GetExtensionName(F)
If Ext = "." & S2 Then
Ext = "." & .GetExtensionName(BN) : Test = InStrRev(BN, S1)
If Ext <> "." Then
If Test Then BN = Left(.GetBaseName(BN), Test - 1)
Else Ext = ""
If Test And IsNumeric(Mid(BN, Test + Len(S1))) Then _
BN = Left(.GetBaseName(BN), Test - 1)
End If
End If : F1 = Path & BN & S1 : S = Ext & "." & S2 : i = 1
While .FileExists(F1 & i & S) : i = i + 1 : Wend
.CopyFile F, F1 & i & S
Else
F1 = Path & .GetFileName(F) & S1 : i = 1
While .FolderExists(F1 & i & "." & S2) : i = i + 1 : Wend
.GetFolder(F).Copy F1 & i & "." & S2
End If
Loop Until List.AtEndOfStream
End With : 'CreateObject("WScript.Shell").SendKeys "^R"Код: Выделить всё
Имена выбранных файлов Результаты
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¯¯¯¯¯¯¯¯¯¯
Name.ext Name<префикс>№+1.ext.<постфикс>
Name.ext.<постфикс> Name<префикс>№+1.ext.<постфикс>
Name<префикс>№.ext.<постфикс> Name<префикс>№+1.ext.<постфикс>
Для папок - без заморочек:
Name Name<префикс>№+1.<постфикс>
Код: Выделить всё
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Cоздать копии с добавочным расширением для выбранных элементов
' с добавлением счётчика в скобках, начиная с последнего номера
' Параметры: %WL "<путь назначения>" <расширение копии>
' Примеры: %WL "%P" | %WL "%T" old
'••••••••••••••••••••••••••••••••••••••••• Автор - Flasher © •••
Option Explicit: Dim C, List, Reg, Path, Ext, ShA,_
FSO, F, Test, Filt, M, Items, Cnt, Max, T, x, i, FN
With WScript.Arguments
C = .Count : Ext = ".bak" : If C = 0 Then WScript.Quit
If C = 1 Then MsgBox "Должно быть указано " & vbCr & _
"не менее 2-х параметров!",48, " BackUp": WScript.Quit
List = .Item(0) : Path = .Item(1)
If C = 3 Then Ext = "." & .Item(2)
End With: Set ShA = CreateObject("Shell.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set List = FSO.OpenTextFile(List,,,-1)
Set Reg = New Regexp
Reg.Pattern = "(.*" & Ext & ") \((\d+)\)$"
Path = FSO.BuildPath(Path, "\")
Do : F = Trim(List.ReadLine)
If F <> "" Then
FN = FSO.GetFileName(F) : Max = 0
If Right(FN, Len(Ext)) = Ext Then T = 1
If Reg.Test(FN) Then
With Reg.Execute(FN)(0) FN = .Submatches(0):_
Max = CLng(.Submatches(1)) End With : T = 1
End If
If T <> 1 Then
FN = FN & Ext : If FSO.FileExists(Path & FN) Or _
FSO.FolderExists(Path & FN) Then T = 1
End If
If FSO.FolderExists(F) Then
Test = 1 : Filt = 73888
Else Test = 0 : Filt = 73920 End If
If T = 1 Then
Set Items = ShA.NameSpace(Path).Items
Items.Filter Filt, FN & " (*)"
Cnt = Items.Count
If Cnt Then
For x = 0 To Cnt - 1
M = Items.Item(x) : If Reg.Test(M) Then _
M = CLng(Reg.Execute(M)(0).Submatches(1)):_
If M > Max Then Max = M
Next : FN = FN & " (" & Max + 1 & ")"
Else FN = FN & " (1)" End If
End If : FN = FSO.BuildPath(Path, FN)
If Test Then FSO.GetFolder(F).Copy FN, 0 Else FSO.CopyFile F, FN, 0
End If
Loop Until List.AtEndOfStreamЧто надо изменить в твоём скрипте (Cоздать копии с добавочным расширением для выбранных элементов с добавлением счётчика в скобках, начиная с последнего номера ), что бы к папкам не прибавлялись расширения и счетчик начинался сразу.Flasher писал(а):Сделал с тем же принципом, только от последнего номера:
Я могу в теме копирование с переименовыванием по счетчику задать вопрос.