Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

VBScript HTA Location Dropdown

VBScript HTA Location Dropdown

VBScript HTA Location Dropdown

Hi All,

I am trying to add a location dropdown list similar to the one that is created for "Building Location" and "Printer Name" in the script written below so that users can pick printers from different sites when on travel. Currently the HTA menu reads from a single text file called "Printers.txt" but what I would like to do is based on one of three locations a, b, or c the program will read from a different list of printers, Printers_a.txt, Printers_b.txt or Printers_c.txt. Please help. Thank you.



<title>Printer Add-in Tool</title>


APPLICATIONNAME="Printer Installation Utility"










<script language="VBScript">

Dim strHTAPath, objDataList

Sub Window_onLoad

intWidth = 470

intHeight = 350

Me.ResizeTo intWidth, intHeight

Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))

If Mid(document.location, 6, 3) = "///" Then

strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)


strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)

End If



End Sub

Sub PopulateRecordSet

Set objFSO = CreateObject("Scripting.FileSystemObject")

Const intForReading = 1

strPrinters = objFSO.GetFile(strHTAPath).ParentFolder & "\Printers.txt"

Const adVarChar = 200

Const MaxCharacters = 255

Set objDataList = CreateObject("ADOR.Recordset")

objDataList.Fields.Append "Building", adVarChar, MaxCharacters

objDataList.Fields.Append "DisplayName", adVarChar, MaxCharacters

objDataList.Fields.Append "SharePath", adVarChar, MaxCharacters


Set objPrinters = objFSO.OpenTextFile(strPrinters, intForReading, False)

While Not objPrinters.AtEndOfStream

strLine = objPrinters.ReadLine

If InStr(strLine, "|") > 0 Then

arrParams = Split(strLine, "|")


objDataList("Building") = arrParams(0)

objDataList("DisplayName") = arrParams(1)

objDataList("SharePath") = arrParams(2)


End If



End Sub

Sub Clear_List(ByVal objListBox)

For intListProgress = 1 To objListBox.Length

objListBox.Remove 0


End Sub

Sub PopulateBuildings


strAdded = ";"

While Not objDataList.EOF

strBuilding = objDataList.Fields("Building").Value

If InStr(strAdded, ";" & strBuilding & ";") = 0 Then

Set objOption = document.createElement("OPTION")

objOption.Text = strBuilding

objOption.Value = strBuilding

lst_building.Add objOption

strAdded = strAdded & strBuilding & ";"

End If





End Sub

Sub PopulatePrinters


Set objOption = document.createElement("OPTION")

objOption.Text = "Select printer..."

objOption.Value = "Select printer..."

lst_printer.Add objOption

If lst_building.Value <> "Select building..." Then

objDataList.Filter = "Building = '" & lst_building.Value & "'"

strAdded = ";"

While Not objDataList.EOF

strPrinter = objDataList.Fields("DisplayName").Value

If InStr(strAdded, ";" & strPrinter & ";") = 0 Then

Set objOption = document.createElement("OPTION")

objOption.Text = strPrinter

objOption.Value = strPrinter

lst_printer.Add objOption

strAdded = strAdded & strPrinter & ";"

End If



objDataList.Filter = ""

End If

End Sub

Sub Add_Printer

Set oShell1 = CreateObject("Wscript.Shell")

strProf = oShell1.ExpandEnvironmentStrings("%USERPROFILE%")

printer8="Congrats!!! Printer"

If lst_printer.Value = "Select printer..." Then

MsgBox "Please select a building and a printer."



HTASleep 1

objDataList.Filter = "Building = '" & lst_building.Value & "' AND DisplayName = '" & lst_printer.Value & "'"

If objDataList.EOF Then

MsgBox "There was an error finding the SharePath for " & lst_printer.Value


'span_progress.InnerHTML = "<img src='./images/loadgraphic.gif'>"

'span_progress1.InnerHTML = "<img src='./images/loadgraphic.gif'>"

'span_progress2.InnerHTML = "<img src='./images/loadgraphic.gif'>"

'span_progress3.InnerHTML = "<img src='./images/loadgraphic.gif'>"

strSharePath = objDataList.Fields("SharePath").Value

Set objFSO = CreateObject("Scripting.FileSystemObject")

Const intForReading = 1

'strScript = objFSO.GetFile(strHTAPath).ParentFolder & "\AddPrinterScript.vbs"

strScript = strProf & "\AddPrinterScript.vbs"

Set objScript = objFSO.CreateTextFile(strScript, True)

objScript.WriteLine "Set objFSO = CreateObject(""Scripting.FileSystemObject"")"

'objScript.WriteLine "Set objFile = objFSO.CreateTextFile(""" & objFSO.GetFile(strHTAPath).ParentFolder & "\ScriptOutput.txt" & """, True)"

objScript.WriteLine "Set objFile = objFSO.CreateTextFile(""" & strProf & "\ScriptOutput.txt" & """, True)"

objScript.WriteLine "Set objNetwork = CreateObject(""WScript.Network"")"

objScript.WriteLine "On Error Resume Next"

objScript.WriteLine "objNetwork.AddWindowsPrinterConnection """ & strSharePath & """"

If chk_default.Checked = True Then objScript.WriteLine "objNetwork.SetDefaultPrinter """ & strSharePath & """"

objScript.WriteLine "If Err.Number = 0 Then"

objScript.WriteLine " objFile.Write """ & printer8 & " Added Successfully."""

objScript.WriteLine "Else"

'objScript.WriteLine " objFile.Write """ & "There was an error connecting to " & lst_printer.Value & """"

objScript.WriteLine " objFile.Write ""You don't have access to the Printer or Its not able to contact the Print Server"" & VbCrLf & Vbcrlf & "" For assistance, login to - http://ithelp - and raise an IR."""

objScript.WriteLine "End If"

objScript.WriteLine "objFile.Close"

objScript.WriteLine "Set objNetwork = Nothing"

objScript.WriteLine "Set objFSO = Nothing"


Set objShell = CreateObject("WScript.Shell")

Set objExec = objShell.Exec("wscript """ & strScript & """")

While objExec.Status = 0

HTASleep 1


'Set objFile = objFSO.OpenTextFile(objFSO.GetFile(strHTAPath).ParentFolder & "\ScriptOutput.txt", intForReading, False)

Set objFile = objFSO.OpenTextFile(strProf & "\ScriptOutput.txt", intForReading, False)

strResult = objFile.ReadAll


Set objFile = Nothing

'objFSO.DeleteFile objFSO.GetFile(strHTAPath).ParentFolder & "\AddPrinterScript.vbs", True

'objFSO.DeleteFile objFSO.GetFile(strHTAPath).ParentFolder & "\ScriptOutput.txt", True

objFSO.DeleteFile strProf & "\AddPrinterScript.vbs", True

objFSO.DeleteFile strProf & "\ScriptOutput.txt", True

'span_progress.InnerHTML = "<br>"

'span_progress1.InnerHTML = "<br>"

'span_progress2.InnerHTML = "<br>"

'span_progress3.InnerHTML = "<br>"

'Msgbox strprof

MsgBox strResult

End If

objDataList.Filter = ""


End If

End Sub

Sub Disable_Controls

document.body.style.cursor = "wait"

lst_building.disabled = True

lst_printer.disabled = True

chk_default.disabled = True

btn_addprinter.disabled = True

End Sub

Sub Enable_Controls

lst_building.disabled = False

lst_printer.disabled = False

chk_default.disabled = False

btn_addprinter.disabled = False

document.body.style.cursor = "arrow"

End Sub

Sub HTASleep(intSeconds)

Set objShell = CreateObject("WScript.Shell")

objShell.Run "ping -n " & intSeconds + 1, 0, True

End Sub



<body style="background-color:#C0C0C0; Font-Family:Garamond">

<table width='90%' height='100%' align='Left' border='0'>


<td align='center' colspan="2">




<td align="Center" style="font-family:Book Antiqua; font-size: 22px; font-weight: bold;color=#800080" colspan="2">

-: <u>Printer Add-in Tool</u> :-<br><br>




<td align='left' style="font-family:Times New Romanl; font-size: 15px; font-weight: bold;">

Select Building:


<td align='left' style="font-family:Times New Roman; font-size: 16px; font-weight: bold;">

<select name="lst_building" id="lst_building" onchange="vbs:PopulatePrinters">

<option id="opt_building_select" value="Select building...">Select building...</option>





<td align='left' style="font-family: Times New Roman; font-size: 15px; font-weight: bold;">

Select Printer:


<td align='left' style="font-family: Times New Roman; font-size: 16px; font-weight: bold;">

<select name="lst_printer" id="lst_printer">

<option id="opt_printer_select" value="Select printer...">Select printer...</option>





<td align='center' colspan="2">

<br><input type="checkbox" id="chk_default" name="chk_default" checked>&nbsp;Set selected printer as the Default Printer<br>

<br><br>&nbsp;<input type="button" value="Add Printer" name="btn_addprinter" onClick="vbs:Add_Printer" style="font-size: 17px;font-family:Garamond">&nbsp;&nbsp;&nbsp;&nbsp;<input type="button" value="Exit" name="btn_exit" onClick=self.close() style="font-size: 17px;font-family:Garamond">&nbsp;&nbsp;

<br><br><span id="span_progress"></span>&nbsp;<span id="span_progress1"></span>&nbsp;

<span id="span_progress2"></span>&nbsp;<span id="span_progress3"></span><br>





Replies continue below

Recommended for you

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close