Feb 28 2012
Install Fonts VBS
This is a revamp of the previous post. It is still a little messy because I am not that familiar with VBS. This script should work for Windows 2000 up to Windows 7. The font folder directory changed in 2000 to XP. Fonts also “install” on Vista and up instead of copying.
On Error Resume Next Dim objShell, objFSO, wshShell, objWMIService, strOS Dim strFontSourcePath, objFolder, objFont, objNameSpace, objFile, strComputer, strOSVersion strComputer = "." Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\\" _ & strComputer & "\root\cimv2") Set colOperatingSystems = objWMIService.ExecQuery _ ("Select * from Win32_OperatingSystem") For Each objOperatingSystem in colOperatingSystems ' Wscript.Echo objOperatingSystem.Caption & _ ' " " & objOperatingSystem.Version strOSVersion = left(objOperatingSystem.Version,3) strOS = objOperatingSystem.Caption Next exists = InStr (strOS, "Server") If exists = 0 Then Set objShell = CreateObject("Shell.Application") Set wshShell = CreateObject("WScript.Shell") Set objFSO = createobject("Scripting.Filesystemobject") strFontSourcePath = "\\server\Software\Fonts\" If objFSO.FolderExists(strFontSourcePath) Then If strOSVersion = "5.0" Then ' Start 2000 Set objNameSpace = objShell.Namespace(strFontSourcePath) Set objFolder = objFSO.getFolder(strFontSourcePath) For Each objFile In objFolder.files If LCase(right(objFile,4)) = ".ttf" OR LCase(right(objFile,4)) = ".otf" Then Set objFont = objNameSpace.ParseName(objFile.Name) If objFSO.FileExists("C:\WINNT\Fonts\" & objFile.Name) = False Then objFSO.CopyFile strFontSourcePath & objFile.Name , "C:\WINNT\fonts\" Set objFont = Nothing Else End If End If Next ElseIf strOSVersion = "5.1" Or strOSVersion = "5.2" Then ' Start Windows XP Set objNameSpace = objShell.Namespace(strFontSourcePath) Set objFolder = objFSO.getFolder(strFontSourcePath) For Each objFile In objFolder.files If LCase(right(objFile,4)) = ".ttf" OR LCase(right(objFile,4)) = ".otf" Then Set objFont = objNameSpace.ParseName(objFile.Name) If objFSO.FileExists("C:\WINDOWS\Fonts\" & objFile.Name) = False Then objFSO.CopyFile strFontSourcePath & objFile.Name , "C:\WINDOWS\Fonts\" Set objFont = Nothing Else End If End If Next ElseIf strOSVersion = "6.0" Or strOSVersion = "6.1" Or strOSVersion = "6.2" Then ' Start Vista, 08, 7, 08R2 Set objNameSpace = objShell.Namespace(strFontSourcePath) Set objFolder = objFSO.getFolder(strFontSourcePath) For Each objFile In objFolder.files If LCase(right(objFile,4)) = ".ttf" OR LCase(right(objFile,4)) = ".otf" Then Set objFont = objNameSpace.ParseName(objFile.Name) If objFSO.FileExists("C:\WINDOWS\Fonts\" & objFile.Name) = False Then objFont.InvokeVerb("Install") Set objFont = Nothing Else End If End If Next Else End If Else Wscript.Echo "Font Source Path does not exists" End IF Else 'Skips the Servers End If
Have fun and good luck scripting.