Jump to content

[VBS] Automatically Install Fonts


Recommended Posts

HI,

Would it be possible to modify this VBScript so that it would automatically install all Fonts located in the same folder as the VBScript with the Font file extensions .fon, .pfm, .ttc, .ttf, .otf?

Const FONTS = &H14&Set objShell = CreateObject("Shell.Application")Set objFolder = objShell.Namespace(FONTS)objFolder.CopyHere "C:\Scripts\HandelGotD1.ttf"objFolder.CopyHere "C:\Scripts\HandelGotD2.fon"
Edited by Mike88
Link to comment
Share on other sites


The naming of the font files will have all kinds of names. ;)

The script should scan the folder where it was executed for the Font file extensions .fon, .pfm, .ttc, .ttf, .otf and then install this Fonts like the script above with "objFolder.CopyHere".

Edited by Mike88
Link to comment
Share on other sites

I have only tested the filter and not the copy function. You will have to edit this to suit your needs.

Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")'-> Start Folder Where Script Is Located And List All Files  For Each i In Fso.GetFolder(".").Files '-> Filter Out The Files Change To Suit Your Needs   If LCase(Right(i.Name,3)) = "vbs" Then    FontCopy(i.Path)   End If    If LCase(Right(i.Name,3)) = "txt" Then    FontCopy(i.Path)   End If  Next '-> Copy The File To The Font Folder   Function FontCopy(F)    Const FONTS = &H14    Dim Shl :Set Shl = CreateObject("Shell.Application")    Dim Obj :Set Obj = Shl.Namespace(FONTS)    Obj.CopyHere F   End Function 
Link to comment
Share on other sites

The script works when i manually execute it but when it is being executed with a Batch file which is not located in the same folder as the VBScript then the VBScript won't work. :}

Edited by Mike88
Link to comment
Share on other sites

The script works when i manually execute it but when it is being executed with a Batch file which is not located in the same folder as the VBScript then the VBScript won't work. :}

could be a Admin issue as well, so either add a admin script to the vbs or your batch and try it that way.

~DP

Link to comment
Share on other sites

To get more help in debugging this issue, you will probably need to provide a little more info, such as:

 

-- OS involved - I assumed Win7 x64, but you mentioned XP as well above, so...

-- 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.

-- 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?

-- Anything else you can think of.

 

Cheers and Regards

Link to comment
Share on other sites

I really didn't change much at all. The script simply won't work when executing it via a Batch file which is located in another folder. And i tested it on Win7 x64 and WinXP x86.

 

Batch:

IF EXIST "New folder\Fonts Installer.vbs" START "" /WAIT "New folder\Fonts Installer.vbs"

VBScript:

Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")'-> Start Folder Where Script Is Located And List All Files  For Each i In Fso.GetFolder(".").Files'-> Filter Out The Files Change To Suit Your Needs   If LCase(Right(i.Name,3)) = "fon" Then    FontCopy(i.Path)   End If   If LCase(Right(i.Name,3)) = "otf" Then    FontCopy(i.Path)   End If   If LCase(Right(i.Name,3)) = "pfm" Then    FontCopy(i.Path)   End If   If LCase(Right(i.Name,3)) = "ttf" Then    FontCopy(i.Path)   End If  Next'-> Copy The File To The Font Folder   Function FontCopy(F)    Const FONTS = &H14&    Dim Shl :Set Shl = CreateObject("Shell.Application")    Dim Obj :Set Obj = Shl.Namespace(FONTS)    Obj.CopyHere F   End FunctionWScript.Quit
Edited by Mike88
Link to comment
Share on other sites

-- 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.

-- 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?

 

Not that I will necessarily be able to help directly, but It seems these things might be important.

 

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?  Have you tried adding "echo" statements to verify that the script is run?

 

Cheers and Regards

Edited by bphlpt
Link to comment
Share on other sites

Well i found a workaround for it, i completely forgot about the Batch START command /D which can set the Working Directory. :rolleyes:

This Batch code is wokring: 

IF EXIST "New folder\Fonts Installer.vbs" START "" /D "New folder" /WAIT "New folder\Fonts Installer.vbs"
Edited by Mike88
Link to comment
Share on other sites

You might want to try this script it uses 2 for each loops and only one If end if.

 

Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")'-> Array To Hold The File TypeDim i, j, v: v = Array("fon","otf","pfm","ttf")'-> Start Folder Where Script Is Located And List All Files   For Each i In Fso.GetFolder(".").Files    For Each j In v '-> Filter Out The Files Type From Array v    If LCase(Right(i.Name,3)) = j Then     FontCopy(i.Path)    End If    Next   Next '-> Copy The File To The Font Folder   Function FontCopy(F)    Const FONTS = &H14&        Dim Shl :Set Shl = CreateObject("Shell.Application")    Dim Obj :Set Obj = Shl.Namespace(FONTS)    Obj.CopyHere F   End Function 
Link to comment
Share on other sites

This one also works without a problem. :)

But what i noticed is, could the script not run into a conflict when using it on a Windows where the text is displayed from "Right to Left" instead of "Left to Right"? :unsure:

Edited by Mike88
Link to comment
Share on other sites

This one filter out the file type

Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")Dim i'-> Start Folder Where Script Is Located And List All Files   For Each i In Fso.GetFolder(".").Files '-> Filter Out The Files     If i.Type = "TrueType font file" Then     FontCopy(i.Path)   End If   Next '-> Copy The File To The Font Folder   Function FontCopy(F)    Const FONTS = &H14&        Dim Shl :Set Shl = CreateObject("Shell.Application")    Dim Obj :Set Obj = Shl.Namespace(FONTS)    Obj.CopyHere F   End Function  
Link to comment
Share on other sites

Well i think with this one we will get a Windows Language conflict. :lol:

Would this be helpful to make it work?

http://stackoverflow.com/questions/4200028/vbscript-list-all-pdf-files-in-folder-and-subfolders

http://stackoverflow.com/questions/12235993/scan-folder-and-list-only-image-files-with-vbscript

Edited by Mike88
Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...