Network Font Installation

Do you constantly get requested by users to install fonts? Or would you like to give users the ability to install their own fonts?

Save the code below as a vbs file, and add it the the computer startup. All you or your users have to do then is put any fonts you/they want installing, into the shared server folder (\\server\share\fonts in the example).

It's built as a subroutine, so you can easily add it to an existing script or run it on its own.

If you ever want to add a new font, just copy it to the server; next time the machines reboot they'll install it. I've made the shared folder available to end users so they can add their own, obviously they need to be aware not to copy hundreds at a time, otherwise other users are not going to be too please next time they start their PCs.

Code:

Sub InstallFonts

   on error resume next

   Const FONTS = &H14

   dim oFSO,oShell,oFolder1,oFolder2,sRoot

   sRoot=\\server\share\fonts\

   set oShell = CreateObject("Shell.Application")

   set oFSO=createobject("scripting.filesystemobject")

   set oFolder1 = oShell.Namespace(FONTS)

   set oFolder2=ofso.getfolder(sRoot)  

   for each oFile in oFolder2.files

   sName=lcase(oFile.name)

      if right(sName,4)=".ttf" then

         if not ofso.fileexists(oFolder1.self.path & "\" & sName) then

            oFolder1.copyhere sRoot & sName

         end if    

      end if  

next  

on error goto 0

End Sub

InstallFonts

Original Source: http://www.edugeek.net/forums/scripts/4756-script-install-fonts-workstations.html#post370283 Thanks to Steve Rochford for this code.