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

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

null@example.com (929151) — Sat, 25 Mar 2017 16:05:17 +0000

Спасибо!

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

null@example.com (Flasher) — Fri, 10 Mar 2017 16:42:25 +0000

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

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

null@example.com (929151) — Mon, 06 Mar 2017 21:54:21 +0000

(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)

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

null@example.com (Flasher) — Fri, 03 Mar 2017 02:27:27 +0000

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

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

null@example.com (929151) — Fri, 03 Mar 2017 01:57:54 +0000

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

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

null@example.com (Flasher) — Fri, 03 Mar 2017 01:42:44 +0000

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

Font Name Bold Italic
Font Name Bold

Font Name Book Italic
Font Name Book

Font Name Black Italic
Font Name Black

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

null@example.com (929151) — Fri, 03 Mar 2017 00:45:31 +0000

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

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

null@example.com (Flasher) — Fri, 03 Mar 2017 00:27:37 +0000

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

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

null@example.com (929151) — Thu, 02 Mar 2017 23:50:13 +0000

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

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

null@example.com (Flasher) — Thu, 02 Mar 2017 23:28:37 +0000

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

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

null@example.com (929151) — Thu, 02 Mar 2017 23:21:10 +0000

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

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

null@example.com (Flasher) — Thu, 02 Mar 2017 23:17:13 +0000

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

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

null@example.com (929151) — Thu, 02 Mar 2017 23:03:24 +0000

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

Мне все-таки нужно выделить 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).

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

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

null@example.com (929151) — Tue, 28 Feb 2017 11:51:18 +0000

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

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

null@example.com (Flasher) — Tue, 28 Feb 2017 10:55:20 +0000

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