Re: Automate window fonts installation by Ian
Ian
Thu Jun 02 13:22:54 CDT 2005
I use the following
' Start of script
Option Explicit
Dim strAddedFonts, updated, sComputer, fso, oReg, strRegValue, sFontName, sFontFile, strIFN
Const HKLM = &H80000002
sComputer = InputBox("What is the computername ","Register Fonts","COMPUTERNAME",1,1)
updated= "Following fonts have been"&vbCr &"registed on "&sComputer &vbCr &vbcr
Set Fso = CreateObject("Scripting.FileSystemObject")
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sComputer & "\root\default:StdRegProv")
strRegvalue = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts"
sFontName = "Kartika (TrueType)"
sFontFile ="Kartika.ttf"
FontUpdate ()
sFontName = "Elephant (TrueType)"
sFontFile ="ELEPHNT.TTF"
FontUpdate ()
msgbox updated
Function FontUpdate ()
' in here place routine to copy fonts from a central repository
' to the target PC
strIFN = "\\"&sComputer &"\C$\Windows\Fonts\"&sFontFile
If Fso.FileExists(strIFN) Then
updated = updated & sFontFile &VbCr
oReg.SetStringValue HKLM, strRegvalue, sFontName, sFontFile
end if
End function
' end of script
Ian
On 24 May 2005 11:31:12 -0700, "citizen" <diportnoy@yahoo.com> wrote:
>I need to install new font on all the 200+ PC's in the Windows 2000
>domain. All stations are Windows XP SP1/SP2.
>
>I there any way to install new fonts either with login script or
>policies, using vbscript or freeware app?
>
>Thank you