Installing Fonts On Windows 7 From A VBScript
Recently I needed to install a number of fonts from a folder into a Windows 7 installation. One notable change with fonts since Windows XP is that you can’t just copy the fonts to the fonts folder. Windows Vista and 7 needs to register the font in the registry.
This is automatically done by right clicking on the font to install and selecting install. However that is a mindless task if you need to do that on more than one computer. If you do choose to do it manually there is also room for human error. So I looked around for a vbscript to install a simple font and found one from Microsoft’s scripting guys. However it only installed one font and I needed to install a whole folder of fonts.
I decided to couple the vbscript with File System Objects to retrieve a directory listing of a specified folder. Then the script for loops thru the collection, as it loops it checks to see if you have the file already. If you don’t have the file it installs it into Windows using the proper install action.
If you decide to make this a startup script, remember that startup scripts are run under the local system security context and won’t be able to connect to remote servers. If you make this a login script the user will need rights to install the fonts. See this article if you choose the login script route: http://www.bohack.com/2011/04/allowing-non-administrators-to-install-fonts-in-windows-7/
Dim strFolder, itmFile
Dim objFSO, objFSOFolder, ObjFiles
Dim objShell, ObjFolder, ObjFolderItem
strfolder = "\\server\share\fonts"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFSOfolder = objFSO.GetFolder(strFolder)
Set objFiles = objFSOfolder.Files
For each itmFile In objFiles
If Not objFSO.FileExists("C:\Windows\Fonts\" & itmFile.Name) Then
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strFolder)
Set objFolderItem = objFolder.ParseName(itmFile.name)
objFolderItem.InvokeVerb("Install")
Set objFolderItem = Nothing
Set objFolder = Nothing
Set objShell = Nothing
End If
Next
Set objFiles = Nothing
Set objFSOfolder = Nothing
Set objFSO = Nothing