Sub InstallFonts
on error resume next
sFontFolder="c:\windows\fonts\"
sFonts=array("SAPI.TTF","SAPIB.TTF","SAPT.TTF","SA PTB.TTF")
sFontNames=array("SassoonPrimaryInfant Regular (TrueType)","SassoonPrimaryInfant Bold (TrueType)","SassoonPrimaryType Regular (TrueType)","SassoonPrimaryType Bold (TrueType)")
for i=lbound(sFonts) to uBound(sFonts)
if not ofso.fileexists(sFontFolder & sFonts(i)) then
ofso.copyfile "\\servername\Fonts$\" & sFonts(i),sFontFolder
oShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts\" & sFontNames(i), sFonts(i), "REG_SZ"
end if
next
on error goto 0
End Sub