[VBS] Automatically Install Fonts

[gunsmokingman]

I only worry about things in English, you can figure out any other problems. You never mention any recursive threw sub folders. I am not here to do your job, I just provided scripts that the user request, I don't fix all the problems.

[Mike88]

Subfolders are not needed it's only an example i posted. If i'm not wrong then this "GetExtensionName" command should solve the problem with the different Windows Languages and the Right to Left text format.

I only don't know how to do this Font Script with the "GetExtensionName" from the example scripts i posted.

 

https://msdn.microsoft.com/en-us/library/x0fxha2a%28v=VS.85%29.aspx?f=255&MSPPError=-2147217396

Script example 1:

For Each objFile in colFiles    If UCase(objFSO.GetExtensionName(objFile.name)) = "PDF" Then        Wscript.Echo objFile.Name    End IfNext

Script example 2:

Set extensions = CreateObject("Scripting.Dictionary")extensions.CompareMode = 1 ' make lookups case-insensitiveextensions.Add "jpg", Trueextensions.Add "png", Trueextensions.Add "gif", TrueFor Each ObjFile In ObjFiles  If extensions.Exists(fso.GetExtensionName(ObjFile)) Then    ObjOutFile.WriteLine(ObjFile.Path)  End IfNext

Edited April 11, 2015 by Mike88

[bphlpt]

While I'm glad that you have made progress, I'm curious.  Why have you not answered my questions?

 

(1) -- Please post the VBScript as you ended up modifying it, and specify exactly where you place the script and the fonts you are trying to install.

(2) -- Please post the batch script that you are using to call the font-install script, and specify exactly where it is located and when you are trying to run it - at OS install, at every OS boot, on demand, or what?

 

(3) And what does "not work" mean?  Anything at all happen?  Any error message?  Are the fonts moved and just not registered, or are they not moved at all?  If nothing happens, how do you know that the script was even called?

 

Your lack of response, and the escalating requirements you are adding, is making me suspicious.  What is your true end goal?  What exactly are you trying to do, when are you trying to do it, and why?  Specifying these things will only help us provide a better solution for you.  Rather than continuing to fine tune you original approach, we might have a completely different idea that might work even better for you if we understood what you were trying to accomplish and why.  Just a thought.

 

Cheers and Regards

Edited April 11, 2015 by bphlpt

[jaclaz]

And if I may, why has been the wished solution be "confined" to a .vbs (particularly if the idea is to run the VBS script from batch?

 

I mean:

@ECHO OFFSETLOCAL ENABLEEXTENSIONSSET MyFontDir=%1IF %1.==. SET MyFontDir=%~dp0FOR /F "tokens=*" %%A in ('DIR /B /S %MyFontDir%') DO (FOR %%B IN (".fon" ".otf" ".pfm" ".ttf") DO (IF "%%~xA"==%%B ECHO COPY %%A %windir%\Fonts))

jaclaz

[bphlpt]

And if registering the fonts is the issue, then this might be of interest - [Tool] FontReg 2.1.3 - Font install and registration repair.

 

Cheers and Regards

[Mike88]

@jaclaz

Unfortunately a Batch Script doesn't register the Fonts.  I Tried 4 of them before moving to VBScript.

 

@bphlpt

I know this regfont tool but i will use this VBScript on 2 different scenarios one to automatically install Windows XP Theme Fonts and second to include the Script into some Custom Theme Font folder so that a User can easily install the Fonts if needed.

Edited April 11, 2015 by Mike88

[jaclaz]

Well, it is perfectly possible to also register fonts from a batch by simply adding the necessary REG.EXE commands, *like* in here:

http://windowsitpro.com/windows/how-can-i-install-font-command-linebatch-file

http://www.msfn.org/board/topic/119612-how-to-install-a-font-via-the-command-line/?p=987846

 but actually it makes very little sense to use BOTH a .vbs (particularly if called from batch) OR a complex batch.

 

With an added size of 6144 bytes you can have Fontreg (same as pointed out by bphlpt):

http://code.kliu.org/misc/fontreg/

and call it a day.

 

Readme.txt:

 

If you...

...run FontReg.exe without any command-line switches:

* FontReg will remove any stale font registrations in the registry.
* FontReg will repair any missing font registrations for fonts located in
the C:\Windows\Fonts directory (this step will be skipped for .fon fonts if
FontReg cannot determine which fonts should have "hidden" registrations).

...run FontReg.exe with the /copy or /move switch:

* FontReg will install all files with a .fon, .ttf, .ttc, or .otf file
extension located in the CURRENT DIRECTORY (which might not necessarily be
the directory in which FontReg is located). Installation will entail
copying/moving the files to C:\Windows\Fonts and then registering the fonts.
* FontReg will remove any stale font registrations in the registry.
* FontReg will repair any missing font registrations for fonts located in
the C:\Windows\Fonts directory (this step will be skipped for .fon fonts if
FontReg cannot determine which fonts should have "hidden" registrations).

FontReg.exe is intended as a replacement for Microsoft's outdated fontinst.exe,
and like fontinst.exe, FontReg.exe is fully silent--it will not print messages,
pop up dialogs, etc.; the process exit code will be 0 if there was no error.

 

 

Still if the question is "How can I install fonts from batch?"

 

jaclaz

Edited April 11, 2015 by jaclaz

[Mike88]

Well after google'ing for [GetExtensionName Namespace(FONTS)] i could assemble a working VBScript from 2 VBScript.

Set sho = CreateObject("Shell.Application")Set fso = CreateObject("Scripting.FileSystemObject")Const FONTS = &H14&Set fontNamespace = sho.Namespace(FONTS)Set folder = fso.getfolder(".")Set extensions = CreateObject("Scripting.Dictionary")extensions.CompareMode = 1 'Make lookups case-insensitive.extensions.Add "fon", Trueextensions.Add "otf", Trueextensions.Add "pfm", Trueextensions.Add "ttf", TrueFor Each file In folder.Files  If extensions.Exists(fso.GetExtensionName(file)) Then    fontNamespace.CopyHere folder & "\" & fso.GetFileName(file)  End IfNextWScript.Quit

Edited April 11, 2015 by Mike88

[gunsmokingman]

Here are some tips to help you

1:\ VBS does not need to Dim A :Set A = Something, but it consider good coding practice to Dim all variable's. This is to help you get used to declaring a variable in more advance programing languages.

Example of a more complex scripting language listing all the files in the parent directory.

MS Jscript

var Fso = new ActiveXObject("Scripting.FileSystemObject")var Itm/* Try File As New Collection Using Fso.GetFolder(".").Files */  try{ var File = new Enumerator(Fso.GetFolder(".").files);  for (; !File.atEnd(); File.moveNext()){ /* Collect The Items */   var i = File.item();Itm +="\r\n File Name   : "+i.Name;}  }catch(e){WScript.Echo(" Error Occur "+e.description);}  /* Show All The Items And Replace The Word Undefined*/  WScript.Echo(Itm.replace("undefined",""))

2:\ Learn to use Array and For Each Loop. If you where to add 2 more font types, you would have to add 2 more lines of code. With an Array and an For Each Loop, you would only add 2 items to the Array.

Try this untested VBS

Const FONTS = &H14&Dim Dic :Set Dic = CreateObject("Scripting.Dictionary")Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")Dim Shl :Set Shl = CreateObject("Shell.Application")Dim Fns :Set Fns = Shl.Namespace(FONTS)Dim i,v :v = Array("fon","otf","pfm", "ttf")  For Each i In v   Dic.CompareMode = 1 'Make lookups case-insensitive.   Dic.Add i, True  Next  For Each i In Fso.getfolder(".").Files   If Dic.Exists(Fso.GetExtensionName(i)) Then    Fns.CopyHere i.Path   End If  Next

[Mike88]

The last script also works without a hitch.

Thanks for the improvement script i'm sure this will help me in the future with other VBScripts.

Edited April 11, 2015 by Mike88

[Outbreaker]

HI,

Is it possible to modify this script to support a silent install command (/s) to suppress the MSG Box when a Font is already installed?

Const FONTS = &H14&Dim Dic :Set Dic = CreateObject("Scripting.Dictionary")Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")Dim Shl :Set Shl = CreateObject("Shell.Application")Dim Fns :Set Fns = Shl.Namespace(FONTS)Dim i,v :v = Array("fon","otf","pfm", "ttf")  For Each i In v   Dic.CompareMode = 1 'Make lookups case-insensitive.   Dic.Add i, True  Next  For Each i In Fso.getfolder(".").Files   If Dic.Exists(Fso.GetExtensionName(i)) Then    Fns.CopyHere i.Path   End If  Next

Edited July 26, 2015 by Outbreaker

[gunsmokingman]

Short answer No, not that I know of.

[Yzöwl]

How does powershell work for this task?

$ShApp = New-Object -ComObject Shell.Application$Fonts = $ShApp.NameSpace(0x14)$Extns = @("*.otf","*.ttf")GCI -Include "$Extns" | %\{$Fonts.CopyHere($_.FullName)\}

[Outbreaker]

I would use this on WinNT5.0 and up and PowerShell is only directly included in Win6.1.

If supresssing this MSG Box is not possible with a VBScript would it then be possible to skip the CopyHere with a silent switch (/s) when a Font file is already installed?

Edited July 28, 2015 by Outbreaker