Friday 2 March 2012

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

No comments:

Post a Comment

Please enter your comment here, all comments are subject to moderation