Mike88

Well, looks like someone didn't install the Intel Chipset driver.

The last script also works without a hitch. Thanks for the improvement script i'm sure this will help me in the future with other VBScripts.

Well after google'ing for [GetExtensionName Namespace(FONTS)] i could assemble a working VBScript from 2 VBScript. Set sho = CreateObject("Shell.Application")Set fso = CreateObject("Scripting.FileSystemObject")Const FONTS = &H14&Set fontNamespace = sho.Namespace(FONTS)Set folder = fso.getfolder(".")Set extensions = CreateObject("Scripting.Dictionary")extensions.CompareMode = 1 'Make lookups case-insensitive.extensions.Add "fon", Trueextensions.Add "otf", Trueextensions.Add "pfm", Trueextensions.Add "ttf", TrueFor Each file In folder.Files If extensions.Exists(fso.GetExtensionName(file)) Then fontNamespace.CopyHere folder & "\" & fso.GetFileName(file) End IfNextWScript.Quit

@jaclaz Unfortunately a Batch Script doesn't register the Fonts. I Tried 4 of them before moving to VBScript. @bphlpt I know this regfont tool but i will use this VBScript on 2 different scenarios one to automatically install Windows XP Theme Fonts and second to include the Script into some Custom Theme Font folder so that a User can easily install the Fonts if needed.

Subfolders are not needed it's only an example i posted. If i'm not wrong then this "GetExtensionName" command should solve the problem with the different Windows Languages and the Right to Left text format. I only don't know how to do this Font Script with the "GetExtensionName" from the example scripts i posted. https://msdn.microsoft.com/en-us/library/x0fxha2a%28v=VS.85%29.aspx?f=255&MSPPError=-2147217396 Script example 1: For Each objFile in colFiles If UCase(objFSO.GetExtensionName(objFile.name)) = "PDF" Then Wscript.Echo objFile.Name End IfNextScript example 2: Set extensions = CreateObject("Scripting.Dictionary")extensions.CompareMode = 1 ' make lookups case-insensitiveextensions.Add "jpg", Trueextensions.Add "png", Trueextensions.Add "gif", TrueFor Each ObjFile In ObjFiles If extensions.Exists(fso.GetExtensionName(ObjFile)) Then ObjOutFile.WriteLine(ObjFile.Path) End IfNext

Well i think with this one we will get a Windows Language conflict. Would this be helpful to make it work? http://stackoverflow.com/questions/4200028/vbscript-list-all-pdf-files-in-folder-and-subfolders http://stackoverflow.com/questions/12235993/scan-folder-and-list-only-image-files-with-vbscript

This one also works without a problem. But what i noticed is, could the script not run into a conflict when using it on a Windows where the text is displayed from "Right to Left" instead of "Left to Right"?

Well i found a workaround for it, i completely forgot about the Batch START command /D which can set the Working Directory. This Batch code is wokring: IF EXIST "New folder\Fonts Installer.vbs" START "" /D "New folder" /WAIT "New folder\Fonts Installer.vbs"

I really didn't change much at all. The script simply won't work when executing it via a Batch file which is located in another folder. And i tested it on Win7 x64 and WinXP x86. Batch: IF EXIST "New folder\Fonts Installer.vbs" START "" /WAIT "New folder\Fonts Installer.vbs"VBScript: Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")'-> Start Folder Where Script Is Located And List All Files For Each i In Fso.GetFolder(".").Files'-> Filter Out The Files Change To Suit Your Needs If LCase(Right(i.Name,3)) = "fon" Then FontCopy(i.Path) End If If LCase(Right(i.Name,3)) = "otf" Then FontCopy(i.Path) End If If LCase(Right(i.Name,3)) = "pfm" Then FontCopy(i.Path) End If If LCase(Right(i.Name,3)) = "ttf" Then FontCopy(i.Path) End If Next'-> Copy The File To The Font Folder Function FontCopy(F) Const FONTS = &H14& Dim Shl :Set Shl = CreateObject("Shell.Application") Dim Obj :Set Obj = Shl.Namespace(FONTS) Obj.CopyHere F End FunctionWScript.Quit

I also run it on Windows XP with an Admin account and it didnt work with the Batch script.

The script works when i manually execute it but when it is being executed with a Batch file which is not located in the same folder as the VBScript then the VBScript won't work.

The naming of the font files will have all kinds of names. The script should scan the folder where it was executed for the Font file extensions .fon, .pfm, .ttc, .ttf, .otf and then install this Fonts like the script above with "objFolder.CopyHere".

HI, Would it be possible to modify this VBScript so that it would automatically install all Fonts located in the same folder as the VBScript with the Font file extensions .fon, .pfm, .ttc, .ttf, .otf? Const FONTS = &H14&Set objShell = CreateObject("Shell.Application")Set objFolder = objShell.Namespace(FONTS)objFolder.CopyHere "C:\Scripts\HandelGotD1.ttf"objFolder.CopyHere "C:\Scripts\HandelGotD2.fon"

Yes the shell style is present in the Theme folder. What i also noticed is if you copy some files and then move a window over the copy progress bar then the progress bar will jumps up. In my opinion there is some kind of progress bar bug in this Theme.

I only get this bug with this Theme and not with ohter custom Themes.