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.