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.

The true ultimate font install for Windows 7 and XP vbs

(OLD post new link below)
Install-font-vbs

I did not create this solely on my own I borrowed the majority of it from one post and added some small things to make it PERFECT. kinda
 

Option Explicit
' Installing multiple Fonts in Windows 7
' http://www.cloudtec.ch 2011
' Edited by Jason Dahmen

Dim objShell, objFSO, wshShell
Dim strFontSourcePath, objFolder, objFont, objNameSpace, objFile

Set objShell = CreateObject("Shell.Application")
Set wshShell = CreateObject("WScript.Shell")
Set objFSO = createobject("Scripting.Filesystemobject")

strFontSourcePath = "\\Sever\Folder\Font_Folder\"
If objFSO.FolderExists(strFontSourcePath) Then
	If objFSO.FolderExists("C:\Users\") Then
		' Start Windows 7/Vista
		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
		' 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 "\\Sever\Folder\Font_Folder\*", "c:\windows\fonts\"
						Set objFont = Nothing
					Else
					End If
				End If
			Next
	End If
Else
	Wscript.Echo "Font Source Path does not exists"
End IF

This will detect for Windows 7 or Windows XP, and then connect to your Fonts directory. It will scan the files in the font directory and check to see if it already in the fonts folder. If it is, it will skip it, if not it will install/copy it.

Hope this makes sense.

First Post

Hey this is my first post.  I finally decide to create a new website under my domain.  It was pretty easy.  Now it is time to edit the php and css to clean stuff up.

Hope to post more in the future.