Создание пустых файлов или папок с возможностью добавления даты к именам
A: Запрос на создание пустых каталогов с датой на конце и счётчиком в имени
при совпадении увенчался универсальным vbs-скриптом в т. ч. и для файлов:
при совпадении увенчался универсальным vbs-скриптом в т. ч. и для файлов:
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Cоздать указанное число пустых файлов/каталогов с добавлением счётчика в скобках,
' начиная с последнего номера существующего элемента
' Параметры: "<путь назначения>" <файл/каталог: 0/1> <число копий> <добавить дату: 1>
' Если 3 параметр отсутствует или записан как "", то число указывается в окне
' Примеры: "%P" 0 | "%T" 0 2 | "%P" 1 5 | "%T" 1 "" 1
' Автор - Flasher ©
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
Option Explicit : Dim C, Path, FTyp, Count, FDate, Text, L, FSO, D, ToDay, ShA,_
F, Filt, BN, Ext, T, FP, Ent, M, Items, Cnt, Ln, x, Item, Max, i, FF, Str1, Str2
With WSH.Arguments
C = .Count : If C = 0 Then WSH.Quit
If C < 2 Then MsgBox "Должно быть указано не менее 2-х параметров!", 4144 : WSH.Quit
Path = .Item(0) : FTyp = .Item(1) : If C = 3 Then Count = .Item(2)
If C = 4 Then FDate = .Item(3)
End With : If Count > 1 Then Text = vbTab & "Число создаваемых копий: " & Count
L = vbnewline : Set FSO = CreateObject("Scripting.FileSystemObject")
If FDate Then
M = Month(Date) : If Len(M) = 1 Then M = "0" & M
D = Day(Date) : If Len(D) = 1 Then D = "0" & D
ToDay = "_" & Year(Date) & "." & M & "." & D
End If : Set ShA = CreateObject("Shell.Application")
If FTyp Then
C = "каталогов" : InPut F, "имя нового каталога:", C, "NewFolder", Count
Filt = 160 : BN = F : If FDate Then BN = BN & ToDay
FP = FSO.BuildPath(Path, BN)
If Not FSO.FolderExists(FP) Then FSO.CreateFolder FP : T = 1
Else : C = "файлов"
InPut F, "имя нового файла:", C, "NewFile.txt", Count
Ext = "." & FSO.GetExtensionName(F) : Filt = 73920
BN = FSO.GetBaseName(F) : If FDate Then BN = BN & ToDay
FP = FSO.BuildPath(Path, BN & Ext)
If Not FSO.FileExists(FP) Then FSO.CreateTextFile(FP) : T = 1
End If
If Not T Or Count > 1 Then
Ent = InStrRev(BN, "(") : Max = 0
If Ent And Right(BN, 1) = ")" Then
M = Mid(BN, Ent + 1, Len(BN) - Ent - 1)
If IsNumeric(M) Then Max = CLng(M)
BN = Left(BN, Ent - 2)
End If
Set Items = ShA.NameSpace(Path).Items
Items.Filter Filt, BN & " (*)" & Ext
Cnt = Items.Count : Ln = Len(BN) + 3
If Cnt Then
For x = 0 to Cnt - 1
Item = FSO.GetFileName(Items.Item(x).Path)
M = Mid(Item, Ln, Len(Item) - Ln - Len(Ext))
If IsNumeric(M) Then : If CLng(M) > Max Then Max = CLng(M)
Next
End If
For i = 1 To Count - T
FP = BN & " (" & Max + i & ")" : FP = FSO.BuildPath(Path, FP)
If FTyp Then FSO.CreateFolder FP Else FSO.CreateTextFile(FP & Ext)
Next
End If : CreateObject("WScript.Shell").SendKeys "^r"
Sub Input(FF, Str, Str1, Str2, Cnt)
FF = Trim(InputBox(L&L&Text&L&L&L&"Введите " & Str,_
Space(25) & "Создание пустых " & Str1, Str2)) : If FF = "" Then WSH.Quit
If Cnt = "" Then InPut Cnt, "число создаваемых копий:", Str1, 5, Cnt
End Sub
Flasher
18.01.2015