Um neue Schriftarten in Windows zu installieren genügt es, die gewünschten *.ttf-Dateien im Explorer in den Fonts-Ordner zu ziehen. Beim Automatisieren dieses Vorgangs merkt man jedoch sehr schnell, dass das einfache Kopieren der Dateien nicht genügt. Die *.ttf-Dateien erscheinen einfach nicht in der Schriftartenliste.
Der Kopiervorgang per Skript läuft also anders ab als der Kopiervorgang per Explorer. Das folgende Skript weist den Explorer an, den Kopiervorgang zu starten, was zu einer korrekt installierten Schriftart führt. Das Skript prüft auch gleich, ob die Schriftart bereits installiert ist, um unschöne Meldungen („Die Schriftart nnn ist bereits installiert …“) zu verhindern.
Zu installierende Schriftarten (*.ttf / *.fon) in einen Ordner „FontsToInstall“ beim Skript ablegen, dann einfach das VBS starten (per Logon-Script funktioniert das nur bei lokalen Administratoren; besser wäre also ein Startup-Skript), und die fehlenden Schriftarten werden installiert.
Wichtig: Es werden alle Dateien vom FontsToInstall Ordner kopiert, da sollten also ausschliesslich Schriftartdateien drin liegen! Getestet auf Windows XP SP2 deutsch.
-
‚ ###########################################
-
‚ # installfont.vbs #
-
‚ # installs font file in windows fonts dir #
-
‚ # (c) 2007 by Gottfried Mayer #
-
‚ ###########################################
-
Dim oFSO, oApp, oFolderCopy, oShell
-
Dim strFontsPath, strScriptPath
-
‚ Create needed Objects
-
Set oFSO = CreateObject(„Scripting.FileSystemObject“)
-
Set oShell = CreateObject(„WScript.Shell“)
-
Set oApp = CreateObject(„Shell.Application“)
-
‚ Get Path of this Script (i.E. C:\Scripts\ or \\server\netlogon\)
-
strScriptPath = WScript.ScriptFullName
-
strScriptPath = left(strScriptPath,instrrev(strScriptPath,„\“))
-
‚ Get Path of Windows Fonts directory
-
strFontsPath = oShell.ExpandEnvironmentStrings(„%WINDIR%“) & „\Fonts“
-
‚ Get Folder Object of Fonts directory (i.E. C:\Scripts\FontsToInstall or \\server\netlogon\FontsToInstall)
-
Set oFolderCopy = oApp.Namespace(strScriptPath & „FontsToInstall“)
-
‚ Check each Font if it already is installed
-
For Each oFont In oFolderCopy.Items
-
If NOT oFSO.FileExists(strFontsPath & „\“ & oFont.Name) Then
-
‚ Tell Explorer to copy the Font – this correctly installs it.
-
oApp.Namespace(strFontsPath).CopyHere oFont
-
End If
-
Next
-
‚ Cleanup Objects
-
Set oFolderCopy = Nothing
-
Set oApp = Nothing
-
Set oShell = Nothing
http://faq-o-matic.net/?p=484