'******************************************************************** ' Имя: CreateFolderWithNameDate.vbs ' Язык: VBScript ' Модификация: Шаповалов Арсений aka ApceH Hypocrite ' Описание: Создаёт в указанной папке новую папку с текущей датой в названии. ' Если папку уже существует, к имени добавляется номер в скобках. '******************************************************************** Option Explicit Function NumberToStr(v, c, n) Dim s, l s = CStr(v) l = Len(S) If l > n Then NumberToStr = s Exit Function End If s = String(n - l, c) & s NumberToStr = s Exit Function End Function Dim ws,FSO,Target,NewTarget,CurDate,CurTime,DirName,Number On Error Resume Next If (WScript.Arguments.Count <> 1) Then MsgBox "Скрипт предназначен для запуска с панели Total Commander!" & vbCrlf & vbCrlf & "Скрипт ожидает ровно 1 параметр:" & vbCrlf & "• папка назначения (обычно ""%P"")" & vbCrlf & vbCrlf & "Внимание!" & vbCrlf & "• Нужно заключать в кавычки параметры, содержащие пробелы.", vbOKOnly+vbCritical, "Неправильное использование" WScript.Quit End If Set FSO = CreateObject("Scripting.FileSystemObject") Target = WScript.Arguments(0) CurDate = Date CurTime = Time DirName = Day(CurDate) & "-" & Right("0" & Month(CurDate), 2) & "-" & Right("0" & Year(CurDate), 2) & "_" & Right("0" & Hour(CurTime), 2) & "-" & Right("0" & Minute(CurTime), 2) NewTarget = Target & "\" & DirName If Not FSO.FolderExists(NewTarget) Then FSO.CreateFolder(NewTarget) Else Number = 2 NewTarget = NewTarget & "-(" Do While FSO.FolderExists(NewTarget & NumberToStr(Number, "0", 2) & ")") Number = Number + 1 Loop ts = NumberToStr(Number, "0", 2) FSO.CreateFolder(NewTarget & NumberToStr(Number, "0", 2) & ")") End If 'Set ws = WScript.CreateObject("WScript.Shell") 'ws.AppActivate "Total Commander " 'ws.SendKeys "^R" On Error Goto 0 '************* Конец ************************************************ |