Schriftart per VBS Installieren

Andres Bohren

Bin heute in einem Forum über folgendes VBS Script gesehen um Schriftarten zu installieren:

<BEGIN installfont.vbs>
' ###########################################
' # 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\)
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 )
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

<END installfont.vbs>

Ich habe das für meine Zwecke angepasst und es funktioniert soweit unter WinXP und Vista. Der User der das Script ausführt, muss aber Admin Rechte haben - sonst kann man keine Schriftarten installieren.

Grüsse
Andres Bohren