Simple vbscript (HTA) to install fonts via SCCM

We have a group of users that need the ability to install fonts (.ttf and .otf). They are not administrators for their machines, so we usually go down there and install the fonts using runas. Since advertised SCCM programs can run as system, I can write a script to copy the fonts into the fonts directory. If I mark the package as allow user to intereact and run as administrator, the script will pop for the user to pick the fonts they want to install. Here is my hta code that runs once a button is clicked:

	Set objShell = CreateObject("Shell.Application")
	Set objFolder = objShell.BrowseForFolder (0, "Install Fonts From (Source):", (0))
	If objFolder Is Nothing Then
		window.close
	Else
		Set objFolderItem = objFolder.Self
		objPath = objFolderItem.Path
	End If

	Set objFso = CreateObject("Scripting.FileSystemObject")
	Set objFolder = objFso.GetFolder(objPath)
	bolGotFonts = False
	For each objFile in objFolder.Files
		If objFolder.Files.Count > 0 Then
		  If lcase(objFso.GetExtensionName(objFile.Path))="ttf" OR lcase(objFso.GetExtensionName(objFile.Path))="otf" then
			bolGotFonts = True
			DataArea.InnerHTML = DataArea.InnerHTML & "<input type=""checkbox"" name=""" & objFile.Path & """>" & objFile.Path & "</input><br/>"
		  End if
		End If
	Next
	if bolGotFonts Then DataArea.InnerHTML = DataArea.InnerHTML & "<br/><input id=runbutton  class=""button"" type=""button"" value=""Install Font"" name=""run_button""

This code will popup a browse dialog and put the filenames found in the select directory into the HTA’s DataArea.innerHTML (DataArea is just a <div>) with a checkbox and button to initiate the copy of the files:

SUB InstallFont
    DIM colChkElem, strDriveName, objChkBox
    SET colChkElem = window.document.getElementsByTagName("input")
    FOR EACH objChkBox IN colChkElem
        IF objChkBox.Type = "checkbox" THEN
            IF objChkBox.checked THEN
                strFileName = objChkBox.name
                Set objShell = CreateObject("Shell.Application")
                Set objFolder = objShell.Namespace(FONTS)
                objFolder.CopyHere strFileName
            END IF
        END IF
    NEXT
    DataArea.InnerHTML = ""
END SUB

Seems to work!