Prev: Return top level folder list and respective sizes from current fol
Next: Processing e-mails as they arrive.
From: Marten on 8 Jul 2010 10:42
From various sources including this newgroup, I have pieced together a
font install scritp that runs as a call from our login script. (code
is below) The fonts to be installed are in a folder and the script
checks for the file name in the Font folder. If it does not exist, the
font is copied in and installed. Works fine on the XP machines but the
Windows 7 machines have added an interesting twist. The font gets
installed but the file gets renamed. But only on some fonts.

I have two questions.
1) Does anyone know why or can direct me to a better location to ask
why the file is automatically renamed?
2) Is there a way to retrieve the font name from the incoming file,
enumerate the installed font names and check for a match?

Marten



option explicit
Dim oFSO, oApp, oFolderCopy, oShell, oFont
Dim strFontsPath, strScriptPath

Const FONTS = &H14&


' Create needed Objects
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
Set oApp = CreateObject("Shell.Application")


' Get Path of Windows Fonts directory
strFontsPath = oShell.ExpandEnvironmentStrings("%WINDIR%") & "\Fonts"
'WScript.Echo ("strFontsPath = " & strFontsPath)


strScriptPath = "L:\Corp\ClientFonts"

' Get Folder Object of Fonts directory (i.E.
C:\Scripts\FontsToInstall or \\server\netlogon\FontsToInstall)
Set oFolderCopy = oApp.Namespace(strScriptPath)

' Check each Font if it already is installed
For Each oFont In oFolderCopy.Items
wscript.echo ("Font = " & strFontsPath & "\" & oFont.Name)

if ucase(right(oFont,4)) = ".TTF" or ucase(right(oFont,4)) =
".PFM" or ucase(right(oFont,4)) = ".FON" then
If NOT oFSO.FileExists(strFontsPath & "\" & oFont.Name)
Then
' Tell Explorer to copy the Font - this
correctly installs it.
oApp.Namespace(strFontsPath).CopyHere oFont
wscript.echo ("Font installed " & oFont)
Else
wscript.echo ("Font exists " & strFontsPath &
"\" & oFont.Name)
End If
end if
Next


' Cleanup Objects
Set oFolderCopy = Nothing
Set oApp = Nothing
Set oShell = Nothing

 | 
Pages: 1
Prev: Return top level folder list and respective sizes from current fol
Next: Processing e-mails as they arrive.