Сделал, однако =)
Единственная проблема, с которой я так и не понял, как быть, это запуск скрипта без копирования его в нужную папку.
Для того, чтобы скрипт не брал в обработку свой файл, пришлось сделать проверку =)
Вообще, я понимаю, что взглянул краем глаза на один из не самых мощных языков программирования, но и это впечатляет.
Думать не хочется, сколько бы времени и сил ушло на то, чтобы обработать 402 файла в 103 директориях.
Однозначно, лучше это время потратить на изучение программирования! =)
Отдельная благодарность за книгу
А. С. Грошев . Программирование на VBS , а так же «Серjve форум» (сам бы ещё долго искал, почему «Запись за пределами области данных» или как оно там. хо-хо.)
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
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)
Всем — Спасибо!
