×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

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

(OP)
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.

<html>

<head>

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

<HTA:APPLICATION

APPLICATIONNAME="Printer Installation Utility"

SCROLL="no"

SINGLEINSTANCE="yes"

WINDOWSTATE="normal"

Icon="./Images/icon.ico"

Maximizebutton="no"

ContextMenu="no"

Selection="no"

Version="1.0"

>

<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)

Else

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

End If

PopulateRecordSet

PopulateBuildings

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

objDataList.Open



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

While Not objPrinters.AtEndOfStream

strLine = objPrinters.ReadLine

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

arrParams = Split(strLine, "|")

objDataList.AddNew

objDataList("Building") = arrParams(0)

objDataList("DisplayName") = arrParams(1)

objDataList("SharePath") = arrParams(2)

objDataList.Update

End If

Wend

objPrinters.Close

End Sub



Sub Clear_List(ByVal objListBox)

For intListProgress = 1 To objListBox.Length

objListBox.Remove 0

Next

End Sub



Sub PopulateBuildings

objDataList.MoveFirst

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

objDataList.MoveNext

Wend

objDataList.MoveFirst

PopulatePrinters

End Sub



Sub PopulatePrinters

Clear_List(lst_printer)

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.MoveNext

Wend

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."

Else

Disable_Controls

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

Else

'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"

objScript.Close

Set objShell = CreateObject("WScript.Shell")

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

While objExec.Status = 0

HTASleep 1

Wend

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

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

strResult = objFile.ReadAll

objFile.Close

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 = ""

Enable_Controls

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 127.0.0.1 -n " & intSeconds + 1, 0, True

End Sub



</script>

</head>

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

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



<tr>

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



</td>

</tr>

<tr>

<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>

</tr>

<tr>

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

Select Building:

</td>

<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>

</select>

</td>

</tr>

<tr>

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

Select Printer:

</td>

<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>

</select>

</td>

</tr>

<tr>

<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>

</td>

</tr>





</table>



</body>

</html>

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