Schriftarten per Skript installieren

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.

1. ' ###########################################
2. ' # installfont.vbs                         #
3. ' # installs font file in windows fonts dir #
4. ' # (c) 2007 by Gottfried Mayer             #
5. ' ###########################################
6.  
7. Dim oFSO, oApp, oFolderCopy, oShell
8. Dim strFontsPath, strScriptPath
9.  
10. ' Create needed Objects
11. Set oFSO = CreateObject("Scripting.FileSystemObject")
12. Set oShell = CreateObject("WScript.Shell")
13. Set oApp = CreateObject("Shell.Application")
14.  
15. ' Get Path of this Script (i.E. C:\Scripts\ or \\server\netlogon\)
16. strScriptPath = WScript.ScriptFullName
17. strScriptPath = left(strScriptPath,instrrev(strScriptPath,"\"))
18.  
19. ' Get Path of Windows Fonts directory
20. strFontsPath = oShell.ExpandEnvironmentStrings("%WINDIR%") & "\Fonts"
21.  
22. ' Get Folder Object of Fonts directory (i.E. C:\Scripts\FontsToInstall or \\server\netlogon\FontsToInstall)
23. Set oFolderCopy = oApp.Namespace(strScriptPath & "FontsToInstall")
24.  
25. ' Check each Font if it already is installed
26. For Each oFont In oFolderCopy.Items
27.   If NOT oFSO.FileExists(strFontsPath & "\" & oFont.Name) Then
28.     ' Tell Explorer to copy the Font – this correctly installs it.
29.     oApp.Namespace(strFontsPath).CopyHere oFont
30.   End If
31. Next
32.  
33. ' Cleanup Objects
34. Set oFolderCopy = Nothing
35. Set oApp = Nothing
36. Set oShell = Nothing