1 (изменено: 929151, 2017-02-28 11:29:45)

Тема: VBS: Объединить файлы в папки по схожему названию

Giorgio Sans.ttf
Giorgio Sans Black Italic.ttf
Giorgio Sans Black.ttf
Giorgio Sans Bold Italic.ttf
Giorgio Sans Bold.ttf
Giorgio Serif.ttf
Giorgio Serif Black Italic.ttf
Giorgio Serif Black.ttf
Giorgio Serif Bold Italic.ttf
Giorgio Serif Bold.ttf

Нужно файлы названия которых начинается с Giorgio Sans … переместить в папку Giorgio Sans, а Giorgio Serif… в папку Giorgio Serif.

2

Re: VBS: Объединить файлы в папки по схожему названию

А разве шрифты с Black не отдельно должны идти?

Точки в конце предложений обязательны. Ознакомьтесь.

3 (изменено: 929151, 2017-02-28 11:28:09)

Re: VBS: Объединить файлы в папки по схожему названию

Да, тоже объединять они в одном семействе Giorgio Sans находятся.

4

Re: VBS: Объединить файлы в папки по схожему названию

Вам значение слова "Ознакомьтесь" ясно? Исправьте свой пост в соответствии с правилами оформления. И далее прошу не нарушать.
До исправлений ответы запрещены.

5

Re: VBS: Объединить файлы в папки по схожему названию

Нужно из списка выделить повторяющиеся слова в названиях файлов Giorgio Sans и Giorgio Serif.
Далее создать папки Giorgio Sans, Giorgio Serif и переместить в них файлы.

Должно получится:
Giorgio Sans\Giorgio Sans.ttf
Giorgio Sans\Giorgio Sans Black Italic.ttf
Giorgio Sans\Giorgio Sans Black.ttf
Giorgio Sans\Giorgio Sans Bold Italic.ttf
Giorgio Sans\Giorgio Sans Bold.ttf
и
Giorgio Serif\Giorgio Serif.ttf
Giorgio Serif\Giorgio Serif Black Italic.ttf
Giorgio Serif\Giorgio Serif Black.ttf
Giorgio Serif\Giorgio Serif Bold Italic.ttf
Giorgio Serif\Giorgio Serif Bold.ttf

6

Re: VBS: Объединить файлы в папки по схожему названию

А что насчёт других шрифтов? Если они не именованы таким образом? Я бы использовал такое решение:

Path = "C:\MyFonts\"

Set Shell = CreateObject("Shell.Application")
Set Reg = New RegExp : Reg.IgnoreCase = True
Reg.Pattern = "\s*(Black|Regular|(Bold)? ?(Italic)?)$"
Set Folder = Shell.NameSpace(Path)
Set Items = Folder.Items
Items.Filter 73920, "*.ttf"
On Error Resume Next
For Each F In Items
	N = Reg.Replace(F.ExtendedProperty("DocTitle"), "")
	If Len(N) Then Folder.NewFolder N :_
	Shell.NameSpace(Path & N).MoveHere F
Next

7 (изменено: 929151, 2017-02-28 12:48:25)

Re: VBS: Объединить файлы в папки по схожему названию

Нет полагаться на свойства шрифта не стоит.
В свойствах в названии может быть что угодно написано (скрипт в дальнейшем все эти кривые названия будет править).
Все шрифты именованы только таким образом Family Name SubFamily.ttf.
Мне нужно как то выделить повторяющуюся часть (семейство шрифта) из названий файлов.

8

Re: VBS: Объединить файлы в папки по схожему названию

Только исправились и опять к тому же возвращаемся?
Предложения должны начинаться с большой буквы и заканчиваться точкой.

9

Re: VBS: Объединить файлы в папки по схожему названию

ExtendedProperty("DocTitle") на Name попробуйте заменить. На x64 этот фокус должен пройти.

10 (изменено: 929151, 2017-02-28 13:37:40)

Re: VBS: Объединить файлы в папки по схожему названию

Из свойств шрифта брать ничего не нужно, там каша которую потом буду править определив FontFamily.
Из названия файлов нужно определить только FontFamily.
http://ipic.su/img/img7/fs/2017-02-28_12-25-38.1488273968.png

11

Re: VBS: Объединить файлы в папки по схожему названию

Это было ясно из предыдущего сообщения, почему замена и предлагается.

12

Re: VBS: Объединить файлы в папки по схожему названию

При замене ExtendedProperty("DocTitle") на Name ничего не происходит.

13

Re: VBS: Объединить файлы в папки по схожему названию

Система x64? В какой папке шрифты расположены?

14

Re: VBS: Объединить файлы в папки по схожему названию

Win10x64 папка (C:\MyFonts).

15

Re: VBS: Объединить файлы в папки по схожему названию

Path = "C:\MyFonts\"

Set Shell = CreateObject("Shell.Application")
Set Reg = New RegExp : Reg.IgnoreCase = True
Reg.Pattern = "\s*(Black|Regular|(Bold)? ?(Italic)?)\.ttf$"
Set Folder = Shell.NameSpace(Path)
Set Items = Folder.Items
Items.Filter 73920, "*.ttf"
On Error Resume Next
For Each F In Items
	N = Reg.Replace(F, "")
	If Len(N) Then Folder.NewFolder N :_
	Shell.NameSpace(Path & N).MoveHere F
Next

16

Re: VBS: Объединить файлы в папки по схожему названию

Так работает, только subfamily (Bold, Italic, Regular, Black) не ограничивается.
Попытаюсь все возможные варианты прописать, но иногда встречаются уникальные, которые не предугадать. (:

17

Re: VBS: Объединить файлы в папки по схожему названию

Примеры уникальных, пож-та.

18

Re: VBS: Объединить файлы в папки по схожему названию

Например:
Frutiger Cyrillic 65 Bold
Frutiger Cyrillic 66 Bold Italic
Как тут отделить 66 Bold Italic?

19

Re: VBS: Объединить файлы в папки по схожему названию

...= "\s*\d*\s*(...

20

Re: VBS: Объединить файлы в папки по схожему названию

Работает. Спасибо.

21

Re: VBS: Объединить файлы в папки по схожему названию

Добрый вечер.

Мне все-таки нужно выделить fontfamily (FF Meta Cond Pro) не привязываясь к subfonfamily (Bold, Italic и тд.), так как названий очень много все не предугадать.

FF Meta Cond Pro Bold Italic
FF Meta Cond Pro Bold
FF Meta Cond Pro Book Italic
FF Msta Cond Pro Book
FF Meta Cond Pro ExtraBold Italic
FF Meta Cond Pro ExtraBold
FF Meta Cond Pro Medium Italic
FF Meta Cond Pro Medium
FF Meta Cond Pro Normal Italic
FF Meta Cond Pro Normal
FF Meta Cond Pro Black Italic
FF Meta Cond Pro Black

Единственное что в голову приходит это сохранить в файл имена файлов и сравнивать первое слово первой строки FF со всеми строками, при положительном результате сравнивать первые два слова FF Meta, затем три FF Meta Cond Pro, затем FF Meta Cond Pro и при несовпадении (ошибке) мы получим нужное нам fontfamily (FF Meta Cond Pro).

Помогите плиз если это возможно.

22

Re: VBS: Объединить файлы в папки по схожему названию

Если файл шрифта окажется единственным, то без отсева начертаний ничего не выйдет.

23

Re: VBS: Объединить файлы в папки по схожему названию

Имена файлов передаются через аргументы, я попробую создать условие чтобы этого избежать при передачи только одного аргумента или перед выполнением посчитаю количество строк в файле.

24

Re: VBS: Объединить файлы в папки по схожему названию

Число строк я и скриптом могу подсчитать. Только зачем? Текстовый файл тут лишний.
Условие с одним шрифтом где и как собираетесь создавать?

25

Re: VBS: Объединить файлы в папки по схожему названию

После передачи имен фалов скрипту:
1 Записать имена в текстовый файл.
2 Определить количество строк в файле.
2,1 Если строк несколько выделить fontfamily автоматически.
2,2 Если строка одна вывести имя файла в InputBox и вручную определить fontfamily.

26

Re: VBS: Объединить файлы в папки по схожему названию

929151
Я же пишу, что текстовый файл не требуется. Есть коллекции.
2.2. Вот тут имеет смысл всё-таки какой-никакой список начертаний в регулярке прописать, чтобы на каждом единичном файле не спотыкаться.

27

Re: VBS: Объединить файлы в папки по схожему названию

Если файл один, то имя файла в (99,9%) и будет являться Fontfamily, а SubFamily будет Regular (Regular в названии файла не будет), но на всякий случай лучше вывести InputBox.
За раз обрабатывается только одно семейство шрифта(до 50-70 шрифтов), так что остановки допустимы.

28

Re: VBS: Объединить файлы в папки по схожему названию

Всё равно остаётся проблема, если будет по два:

Font Name Bold Italic
Font Name Bold

Font Name Book Italic
Font Name Book

Font Name Black Italic
Font Name Black

29

Re: VBS: Объединить файлы в папки по схожему названию

Может в получаемой FontFamily сделать проверку на Ultra, Heavy, Black, Bold, Medium, Book, Hair, Light, Thin, Hair, (0-9), Regular, Narrow, Italic и тогда тоже выводить InputBox?

30

Re: VBS: Объединить файлы в папки по схожему названию

В случае отсутствия? Логично. Для ускорения стоит сразу перемещать, если такие подстроки есть. А потом обрабатывать оставшееся.
А что такое (0-9)? И кроме Italic вторым словом ещё какое-то может идти?

31 (изменено: 929151, 2017-03-07 04:25:21)

Re: VBS: Объединить файлы в папки по схожему названию

(0-9) это цифры. Кроме Italic может быть (Cond Demi Bold Italic).
Вот что у меня получается. Это я ещё не все варианты учёл. Может можно как то оптимизировать?

Set DataList = CreateObject("System.Collections.ArrayList")
Set DataListName = CreateObject("System.Collections.ArrayList")

DataList.Add "Verdana Pro Regular"
DataList.Add "Verdana Pro Thin"
DataList.Add "Verdana Pro ExtraLight"
DataList.Add "Verdana Pro Light"
DataList.Add "Verdana Pro SemiLight"
DataList.Add "Verdana Pro Regular"
DataList.Add "Verdana Pro News"
DataList.Add "Verdana Pro Medium"
DataList.Add "Verdana Pro SemiBold"
DataList.Add "Verdana Pro Bold"
DataList.Add "Verdana Pro ExtraBold"
DataList.Add "Verdana Pro Heavy"
DataList.Add "Verdana Pro Black"
DataList.Add "Verdana Pro ExtraBlack"
' DataList.Add "---------------------------------------"
DataList.Add "Verdana Pro Italic"
DataList.Add "Verdana Pro Thin Italic"
DataList.Add "Verdana Pro ExtraLight Italic"
DataList.Add "Verdana Pro Light Italic"
DataList.Add "Verdana Pro SemiLight Italic"
DataList.Add "Verdana Pro News Italic"
DataList.Add "Verdana Pro Medium Italic"
DataList.Add "Verdana Pro SemiBold Italic"
DataList.Add "Verdana Pro Bold Italic"
DataList.Add "Verdana Pro ExtraBold Italic"
DataList.Add "Verdana Pro Heavy Italic"
DataList.Add "Verdana Pro Black Italic"
DataList.Add "Verdana Pro ExtraBlack Italic"
' DataList.Add "---------------------------------------"
DataList.Add "Verdana Pro Oblique"
DataList.Add "Verdana Pro Thin Oblique"
DataList.Add "Verdana Pro ExtraLight Oblique"
DataList.Add "Verdana Pro Light Oblique"
DataList.Add "Verdana Pro SemiLight Oblique"
DataList.Add "Verdana Pro News Oblique"
DataList.Add "Verdana Pro Medium Oblique"
DataList.Add "Verdana Pro SemiBold Oblique"
DataList.Add "Verdana Pro Bold Oblique"
DataList.Add "Verdana Pro ExtraBold Oblique"
DataList.Add "Verdana Pro Heavy Oblique"
DataList.Add "Verdana Pro Black Oblique"
DataList.Add "Verdana Pro ExtraBlack Oblique"
' DataList.Add "---------------------------------------"
DataList.Add "Verdana Pro Hairline"
DataList.Add "Verdana Pro Hairline Italic"
' DataList.Add "---------------------------------------"
DataList.Add "Verdana Pro Book"
DataList.Add "Verdana Pro Book Oblique"
DataList.Add "Verdana Pro Book Italic"
DataList.Add "Verdana Pro Book Thin"
DataList.Add "Verdana Pro Book Thin Italic"
DataList.Add "Verdana Pro Book Light"
DataList.Add "Verdana Pro Book Light Italic"
DataList.Add "Verdana Pro Book Ultra Light"
DataList.Add "Verdana Pro Book Ultra Bold"
DataList.Add "Verdana Pro Book Ultra Light Italic"
' DataList.Add "---------------------------------------"
DataList.Add "Verdana Pro Cond Semi Ultra Light Italic"
DataList.Add "Verdana Pro Cond Book Ultra Light Italic"
DataList.Add "Verdana Pro Cond Narrow Ultra Light Italic"
' DataList.Add "---------------------------------------"
DataList.Add "Verdana Pro Narrow"
DataList.Add "Verdana Pro Narrow Regular Italic"
DataList.Add "Verdana Pro Narrow Regular"
DataList.Add "Verdana Pro Narrow Italic"
DataList.Add "Verdana Pro Narrow Bold"
DataList.Add "Verdana Pro Narrow Demi"
DataList.Add "Verdana Pro Narrow Medium"
DataList.Add "Verdana Pro Narrow Medium Italic"
DataList.Add "Verdana Pro Narrow Bold Italic"
DataList.Add "Verdana Pro Narrow Oblique"
DataList.Add "Verdana Pro Narrow Book"
DataList.Add "Verdana Pro Narrow Book Italic"
DataList.Add "Verdana Pro Narrow Light"
DataList.Add "Verdana Pro Narrow Light Italic"
DataList.Add "Verdana Pro Narrow Thin"
DataList.Add "Verdana Pro Narrow Thin Italic"
DataList.Add "Verdana Pro Narrow Extra Bold"
DataList.Add "Verdana Pro Narrow Extra Bold Italic"
DataList.Add "Verdana Pro Narrow Ultra Light Italic"
DataList.Add "Verdana Pro Narrow Ultra Light"

For Each strItem in DataList :  Set Reg = New RegExp : Reg.IgnoreCase = True
comm = "(?:Cond|Demi|Semi|Thin|Medium|Light|Black|(Book)?(Narrow)?|(Bold)?|(Heavy)?|(Light )?) ?(Book)? ?(Ultra)? ?(Extra)? ?(Bold)? ?(Regular)? ?(Light)? ?(Italic)? ?(Oblique)?)"
Reg.Pattern = "\s*\d*\s*(Italic\s*"&comm&"$|"_
		&"\s*\d*\s*(Bold\s*"&comm&"$|"_
		&"\s*\d*\s*(Regular\s*"&comm&"$|"_
		&"\s*\d*\s*(Thin\s*"&comm&"$|"_
		&"\s*\d*\s*(Extra\s*"&comm&"$|"_
		&"\s*\d*\s*(Light\s*"&comm&"$|"_
		&"\s*\d*\s*(Semi\s*"&comm&"$|"_
		&"\s*\d*\s*(News\s*"&comm&"$|"_
		&"\s*\d*\s*(Medium\s*"&comm&"$|"_
		&"\s*\d*\s*(Black\s*"&comm&"$|"_
		&"\s*\d*\s*(Oblique\s*"&comm&"$|"_
		&"\s*\d*\s*(Book\s*"&comm&"$|"_
		&"\s*\d*\s*(Cond\s*"&comm&"$|"_
		&"\s*\d*\s*(Hairline\s*"&comm&"$|"_
		&"\s*\d*\s*(Narrow\s*"&comm&"$|"_
		&"\s*\d*\s*(Heavy\s*"&comm&"$"
	N = Reg.Replace(strItem, "")
	DataListName.Add N
Next
wscript.echo join(DataListName.ToArray(), vbCrLf) 
DataListName.Sort()
wscript.echo "Font Family: " & DataListName(0)

32

Re: VBS: Объединить файлы в папки по схожему названию

Path = "C:\MyFonts\"

Set Shell = CreateObject("Shell.Application")
Set Reg = New RegExp : Reg.IgnoreCase = True
Reg.Pattern = "\s*\d*\s*(Black|(Exstra)?(Book|Bold)|Cond|Hairline|Heavy|Light|Medium|Narrow|News|Oblique|Semi(Bold|Light)|Thin)(Regular)? ?(Bold)? ?(Oblique|Italic)?\.ttf$"
Set Folder = Shell.NameSpace(Path)
Set Items = Folder.Items
Items.Filter 73920, "*.ttf"

For Each F In Items
	N = Reg.Replace(F, "")
	If Len(N) And VarType(Items.Item(CStr(F))) = 8 Then
		Folder.NewFolder N
		Set Itms = Folder.Items
		Itms.Filter 73920, N & "*.ttf"
		If Itms.Count Then Shell.NameSpace(Path & N).MoveHere Itms, 20
	End If
Next

33

Re: VBS: Объединить файлы в папки по схожему названию

Спасибо!