Sub Report_File (decafolder)
          Dim fold1
          Set f_txt = fso.CreateTextFile (decafolder & "\report.txt")
          f_txt.WriteLine ("summ = $00.0")
          f_txt.WriteLine ("allt - 0.00 h")
          f_txt.WriteLine ("regl - 00")
          f_txt.WriteBlankLines ( 1 )
          f_txt.WriteLine ("Name — Time (min)")
          Set w = fso.GetFolder (decafolder)
          Set fold_coll = w.SubFolders
          For Each fold1 in fold_coll
          str = fold1.Name & " — 00"
          Set f_txt = fso.OpenTextFile (decafolder & "\report.txt",  1 )
          f_txt.ReadAll
          'ns = f_txt.Line
          Set f_txt = fso.OpenTextFile (decafolder & "\report.txt",  8 )
          f_txt.WriteLine (str)
          f_txt.Close
          Next
End Sub

'number of characters wich must to remove from file name
noc = InputBox("Укажите, пожалуйста, кол-во символов (с начала строки), которые следует удалить из названия файла" & vbLF & vbLF & "например, если имя было: DSCN4567.jpg, и ввести «4», то станет — 4567.jpg", "Ввод данных для переименования файлов", "4")
Q = InputBox("Укажите, пожалуйста, кол-во экземпляров в партии:", "Ввод данных для группировки файлов", "10")
M = InputBox("Укажите, пожалуйста, порядковый номер начальной партии:" & vbLF & vbLF & "Актуально, если Вы уже работали с этой поставкой.", "Ввод данных для группировки файлов", "1")
Dim f1
Set FSO = CreateObject("Scripting.FileSystemObject")

'получаем файл текущего сценария:
Set script_file = FSO.GetFile(WScript.ScriptName)
PFolder = script_file.ParentFolder
' получаем родительскую папку:
Set f = fso.GetFolder(PFolder)
' получаем коллекцию её файлов:
Set fc = f.Files
' запускаем цикл группирования:
k =  1  : l =  1  : n = M
For Each f1 in fc
' проверяем, не является ли файл нашим скриптом:
If FSO.GetExtensionName(f1) <> "vbs" Then
' получаем базовое имя файла и суффикс:
file_basename = FSO.GetBaseName(f1)
suffix = Mid (file_basename,  9 )
' оставляем цифровую часть имени:
new_basename = Mid (file_basename, noc +  1 )
If l <>  1  Then
          If l = Q+ 1  Then
          Call Report_File (decafolder)
          n = n +  1 
          l =  1 
          End If
End If
If k =  1  Then
         If l =  1  Then
                  num_fold = Right ("00" & n,  2 )
                  decafolder = fso.CreateFolder(f.Name & "_" & num_fold)
         End If
new_group_folder = new_basename
a = FSO.CreateFolder (decafolder & "/" & new_group_folder)
FSO.CopyFile "D:\_ЧАСЫ_\_prepared_\__work_watch__.psd", decafolder & "/" & new_group_folder & "/" & new_basename & "_0.psd"
End If
FSO.MoveFile file_basename & ".jpg", decafolder & "/" & new_group_folder & "/" & file_basename & ".jpg"
k = k +  1 
If suffix = "_articul" or suffix = "_end" Then
                                          k =  1 
                                          l = l +  1 
                                          End If
If suffix = "_end" Then FSO.CopyFile "D:\_ЧАСЫ_\_prepared_\без артикула", decafolder & "/" & new_group_folder & "/без артикула"
End If
Next
Call Report_File (decafolder)