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.