Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Animated HTA

Posted on 2009-02-17
13
Medium Priority
?
1,211 Views
Last Modified: 2012-05-06
Hi,

I have the below code given to me by RobSampson for printer configuration. I just want a progress bar when the Add printer button is pressed, (while adding the printer).

Link: http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23964083.html
<html>
<head>
<title>Connect Printer To Workstation</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Connect Printer To Workstation"
     BORDER="thin"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="normal"
>
 
<script language="VBScript">
 
Dim strHTAPath, objDataList
 
Sub Window_onLoad
	intWidth = 600
	intHeight = 480
	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 "Floor", 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("Floor") = arrParams(1)
			objDataList("DisplayName") = arrParams(2)
			objDataList("SharePath") = arrParams(3)
			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
	PopulateFloors
End Sub
 
Sub PopulateFloors
	Clear_List(lst_floor)
	Set objOption = document.createElement("OPTION")
	objOption.Text = "Select floor..."
	objOption.Value = "Select floor..."
	lst_floor.Add objOption
	If lst_building.Value <> "Select building..." Then
		objDataList.Filter = "Building = '" & lst_building.Value & "'"
		strAdded = ";"
		While Not objDataList.EOF
			strFloor = objDataList.Fields("Floor").Value
			If InStr(strAdded, ";" & strFloor & ";") = 0 Then
				Set objOption = document.createElement("OPTION")
				objOption.Text = strFloor
				objOption.Value = strFloor
				lst_floor.Add objOption
				strAdded = strAdded & strFloor & ";"
			End If
			objDataList.MoveNext
		Wend
		objDataList.Filter = ""
	End If
	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_floor.Value <> "Select floor..." Then
		objDataList.Filter = "Building = '" & lst_building.Value & "' AND Floor = '" & lst_floor.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
	If lst_printer.Value = "Select printer..." Then
		MsgBox "Please select a building, floor, and printer."
	Else
		objDataList.Filter = "Building = '" & lst_building.Value & "' AND Floor = '" & lst_floor.Value & "' AND DisplayName = '" & lst_printer.Value & "'"
		If objDataList.EOF Then
			MsgBox "There was an error finding the SharePath for " & lst_printer.Value
		Else
			strSharePath = objDataList.Fields("SharePath").Value
			Set objNetwork = CreateObject("WScript.Network")
			On Error Resume Next
			objNetwork.AddWindowsPrinterConnection strSharePath
			If Err.Number <> 0 Then
				Err.Clear
				MsgBox "There was an error connecting to " & lst_printer.Value
			Else
				If chk_default.Checked = True Then objNetwork.SetDefaultPrinter strSharePath
			End If
			Set objNetwork = Nothing
		End If
		objDataList.Filter = ""
	End If
End Sub
</script>
</head>
<body style="background-color:#B0C4DE">
	<table width='90%' height='100%' align='center' border='0'>
		<tr>
			<td align="center" style="font-family: arial; font-size: 24px; font-weight: bold;" colspan="2">
				Connect Printer To Workstation
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				Select building:
			</td>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				<select name="lst_building" id="lst_building" onchange="vbs:PopulateFloors">
					<option id="opt_building_select" value="Select building...">Select building...</option>
				</select>
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				Select floor:
			</td>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				<select name="lst_floor" id="lst_floor" onchange="vbs:PopulatePrinters">
					<option id="opt_floor_select" value="Select floor...">Select floor...</option>
				</select>
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				Select printer:
			</td>
			<td align='left' style="font-family: arial; 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">
				<input type="checkbox" id="chk_default" name="chk_default">&nbsp;Set selected printer as the default printer
				<br><br><input type="button" value="Add Printer" name="btn_addprinter"  onClick="vbs:Add_Printer" style="font-size: 16px;"><br><br>
			</td>
		</tr>
	</table>
</body>
</html>

Open in new window

0
Comment
Question by:Dhiraj Mutha
  • 6
  • 6
13 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 23663815
Hi there.

I'm not sure we can tell the "progress" of the AddWindowsPrinterConnection, but I can disable all of the controls so that you can't click anything while it waits....

Regards,

Rob.
<html>
<head>
<title>Connect Printer To Workstation</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Connect Printer To Workstation"
     BORDER="thin"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="normal"
>
 
<script language="VBScript">
 
Dim strHTAPath, objDataList
 
Sub Window_onLoad
	intWidth = 600
	intHeight = 480
	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 "Floor", 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("Floor") = arrParams(1)
			objDataList("DisplayName") = arrParams(2)
			objDataList("SharePath") = arrParams(3)
			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
	PopulateFloors
End Sub
 
Sub PopulateFloors
	Clear_List(lst_floor)
	Set objOption = document.createElement("OPTION")
	objOption.Text = "Select floor..."
	objOption.Value = "Select floor..."
	lst_floor.Add objOption
	If lst_building.Value <> "Select building..." Then
		objDataList.Filter = "Building = '" & lst_building.Value & "'"
		strAdded = ";"
		While Not objDataList.EOF
			strFloor = objDataList.Fields("Floor").Value
			If InStr(strAdded, ";" & strFloor & ";") = 0 Then
				Set objOption = document.createElement("OPTION")
				objOption.Text = strFloor
				objOption.Value = strFloor
				lst_floor.Add objOption
				strAdded = strAdded & strFloor & ";"
			End If
			objDataList.MoveNext
		Wend
		objDataList.Filter = ""
	End If
	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_floor.Value <> "Select floor..." Then
		objDataList.Filter = "Building = '" & lst_building.Value & "' AND Floor = '" & lst_floor.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
	If lst_printer.Value = "Select printer..." Then
		MsgBox "Please select a building, floor, and printer."
	Else
		Disable_Controls
		HTASleep 1
		objDataList.Filter = "Building = '" & lst_building.Value & "' AND Floor = '" & lst_floor.Value & "' AND DisplayName = '" & lst_printer.Value & "'"
		If objDataList.EOF Then
			MsgBox "There was an error finding the SharePath for " & lst_printer.Value
		Else
			strSharePath = objDataList.Fields("SharePath").Value
			Set objNetwork = CreateObject("WScript.Network")
			On Error Resume Next
			objNetwork.AddWindowsPrinterConnection strSharePath
			If Err.Number <> 0 Then
				Err.Clear
				MsgBox "There was an error connecting to " & lst_printer.Value
			Else
				If chk_default.Checked = True Then objNetwork.SetDefaultPrinter strSharePath
			End If
			Set objNetwork = Nothing
		End If
		objDataList.Filter = ""
		Enable_Controls
	End If
End Sub
 
Sub Disable_Controls
	document.body.style.cursor = "wait"
	lst_building.disabled = True
	lst_floor.disabled = True
	lst_printer.disabled = True
	chk_default.disabled = True
	btn_addprinter.disabled = True
End Sub
 
Sub Enable_Controls
	lst_building.disabled = False
	lst_floor.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:#B0C4DE">
	<table width='90%' height='100%' align='center' border='0'>
		<tr>
			<td align="center" style="font-family: arial; font-size: 24px; font-weight: bold;" colspan="2">
				Connect Printer To Workstation
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				Select building:
			</td>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				<select name="lst_building" id="lst_building" onchange="vbs:PopulateFloors">
					<option id="opt_building_select" value="Select building...">Select building...</option>
				</select>
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				Select floor:
			</td>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				<select name="lst_floor" id="lst_floor" onchange="vbs:PopulatePrinters">
					<option id="opt_floor_select" value="Select floor...">Select floor...</option>
				</select>
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				Select printer:
			</td>
			<td align='left' style="font-family: arial; 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">
				<input type="checkbox" id="chk_default" name="chk_default">&nbsp;Set selected printer as the default printer
				<br><br><input type="button" value="Add Printer" name="btn_addprinter"  onClick="vbs:Add_Printer" style="font-size: 16px;"><br><br>
			</td>
		</tr>
	</table>
</body>
</html>

Open in new window

0
 
LVL 14

Author Comment

by:Dhiraj Mutha
ID: 23666842
Ya thats there, but cant we have a progress bar in it... please try.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23666923
Hmmm, the only thing we might be able to do is have like a few dots flashing, but it will never be a true progress indicator......would that still be useful?

Regards,

Rob.
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 14

Author Comment

by:Dhiraj Mutha
ID: 23666997
Yes sure... i want something animated on it that will be ok...
0
 
LVL 14

Expert Comment

by:rejoinder
ID: 23674660
This may or may not meet what you want in the way of a progress indicator but here goes...
When you press the Add Printer button, the button will disappear and you should see a little green progress indicator.  Depending on how fast your workstations are, they might not even see the graphic.  HTA's are notorious for not updating while a sub or function is being processed - there is a strong change you will not see the desired effect.

In any event, download the attached gif file and place in the same directory as the HTA.
<html>
<head>
<title>Connect Printer To Workstation</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Connect Printer To Workstation"
     BORDER="thin"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="normal"
>
 
<script language="VBScript">
 
Dim strHTAPath, objDataList
 
Sub Window_onLoad
	intWidth = 600
	intHeight = 480
	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 "Floor", 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("Floor") = arrParams(1)
			objDataList("DisplayName") = arrParams(2)
			objDataList("SharePath") = arrParams(3)
			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
	PopulateFloors
End Sub
 
Sub PopulateFloors
	Clear_List(lst_floor)
	Set objOption = document.createElement("OPTION")
	objOption.Text = "Select floor..."
	objOption.Value = "Select floor..."
	lst_floor.Add objOption
	If lst_building.Value <> "Select building..." Then
		objDataList.Filter = "Building = '" & lst_building.Value & "'"
		strAdded = ";"
		While Not objDataList.EOF
			strFloor = objDataList.Fields("Floor").Value
			If InStr(strAdded, ";" & strFloor & ";") = 0 Then
				Set objOption = document.createElement("OPTION")
				objOption.Text = strFloor
				objOption.Value = strFloor
				lst_floor.Add objOption
				strAdded = strAdded & strFloor & ";"
			End If
			objDataList.MoveNext
		Wend
		objDataList.Filter = ""
	End If
	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_floor.Value <> "Select floor..." Then
		objDataList.Filter = "Building = '" & lst_building.Value & "' AND Floor = '" & lst_floor.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
	If lst_printer.Value = "Select printer..." Then
		MsgBox "Please select a building, floor, and printer."
	Else
		objDataList.Filter = "Building = '" & lst_building.Value & "' AND Floor = '" & lst_floor.Value & "' AND DisplayName = '" & lst_printer.Value & "'"
		If objDataList.EOF Then
			MsgBox "There was an error finding the SharePath for " & lst_printer.Value
		Else
                        btn_addprinter.classname = "HideFromGUI"
			ProgessBar.classname = ""
			strSharePath = objDataList.Fields("SharePath").Value
			Set objNetwork = CreateObject("WScript.Network")
			On Error Resume Next
			objNetwork.AddWindowsPrinterConnection strSharePath
			If Err.Number <> 0 Then
				Err.Clear
				MsgBox "There was an error connecting to " & lst_printer.Value
			Else
				If chk_default.Checked = True Then objNetwork.SetDefaultPrinter strSharePath
			End If
			Set objNetwork = Nothing
			ProgessBar.classname = "HideFromGUI"
                        btn_addprinter.classname = ""
		End If
		objDataList.Filter = ""
	End If
End Sub
</script>
</head>
 
<STYLE TYPE="text/css">
<!--
.HideFromGUI	{display:none;}
-->
</STYLE>
 
<body style="background-color:#B0C4DE">
	<table width='90%' height='100%' align='center' border='0'>
		<tr>
			<td align="center" style="font-family: arial; font-size: 24px; font-weight: bold;" colspan="2">
				Connect Printer To Workstation
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				Select building:
			</td>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				<select name="lst_building" id="lst_building" onchange="vbs:PopulateFloors">
					<option id="opt_building_select" value="Select building...">Select building...</option>
				</select>
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				Select floor:
			</td>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				<select name="lst_floor" id="lst_floor" onchange="vbs:PopulatePrinters">
					<option id="opt_floor_select" value="Select floor...">Select floor...</option>
				</select>
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				Select printer:
			</td>
			<td align='left' style="font-family: arial; 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">
				<input type="checkbox" id="chk_default" name="chk_default">&nbsp;Set selected printer as the default printer
				<br><br>
<img src="loadgraphic.gif" id="ProgessBar" class="HideFromGUI">
<input type="button" value="Add Printer" id="btn_addprinter" name="btn_addprinter"  onClick="vbs:Add_Printer" style="font-size: 16px;"><br><br>
			</td>
		</tr>
	</table>
</body>
</html>

Open in new window

loadgraphic.gif
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 1000 total points
ID: 23676616
OK here we go.

I've used Rejoinder's graphic.  Place that gif file in the same folder as the HTA, and this should run OK.

VBScript code normally runs sequentially, and when the AddWindowsPrinterConnection method is called, no other code runs, and no screen elements are updated.  So, in normal situations, nothing will happen until the AddWindowsPrinterConnection method returns a response.

What I have had to do is write the Add Printer script parts out to a VBS file, and have the HTA shell out to that VBS file, where we can then use the objShell.Exec method to loop until the script has finished. This loop allows us to run other code, and allow the HTA to update it's elements.

The VBS file that is dynamically created attemps the AddWindowsPrinterConnection method asynchronously to the running HTA, and outputs its result to a text file.  When the HTA detects that the script has finished, it opens the text file that the VBS created, and reads the return value.

It's a very long winded process, but it's the only way around what is otherwise normal synchronous code.

Regards,

Rob.
<html>
<head>
<title>Connect Printer To Workstation</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Connect Printer To Workstation"
     BORDER="thin"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="normal"
>
 
<script language="VBScript">
 
Dim strHTAPath, objDataList
 
Sub Window_onLoad
	intWidth = 600
	intHeight = 480
	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 "Floor", 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("Floor") = arrParams(1)
			objDataList("DisplayName") = arrParams(2)
			objDataList("SharePath") = arrParams(3)
			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
	PopulateFloors
End Sub
 
Sub PopulateFloors
	Clear_List(lst_floor)
	Set objOption = document.createElement("OPTION")
	objOption.Text = "Select floor..."
	objOption.Value = "Select floor..."
	lst_floor.Add objOption
	If lst_building.Value <> "Select building..." Then
		objDataList.Filter = "Building = '" & lst_building.Value & "'"
		strAdded = ";"
		While Not objDataList.EOF
			strFloor = objDataList.Fields("Floor").Value
			If InStr(strAdded, ";" & strFloor & ";") = 0 Then
				Set objOption = document.createElement("OPTION")
				objOption.Text = strFloor
				objOption.Value = strFloor
				lst_floor.Add objOption
				strAdded = strAdded & strFloor & ";"
			End If
			objDataList.MoveNext
		Wend
		objDataList.Filter = ""
	End If
	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_floor.Value <> "Select floor..." Then
		objDataList.Filter = "Building = '" & lst_building.Value & "' AND Floor = '" & lst_floor.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
	If lst_printer.Value = "Select printer..." Then
		MsgBox "Please select a building, floor, and printer."
	Else
		Disable_Controls
		HTASleep 1
		objDataList.Filter = "Building = '" & lst_building.Value & "' AND Floor = '" & lst_floor.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='loadgraphic.gif'>"
			strSharePath = objDataList.Fields("SharePath").Value
			Set objFSO = CreateObject("Scripting.FileSystemObject")
			Const intForReading = 1
			strScript = objFSO.GetFile(strHTAPath).ParentFolder & "\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 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 """ & lst_printer.Value & " connected successfully."""
			objScript.WriteLine "Else"
			objScript.WriteLine "	objFile.Write """ & "There was an error connecting to " & lst_printer.Value & """"
			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)
			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
			span_progress.InnerHTML = "<br>"
			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_floor.disabled = True
	lst_printer.disabled = True
	chk_default.disabled = True
	btn_addprinter.disabled = True
End Sub
 
Sub Enable_Controls
	lst_building.disabled = False
	lst_floor.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:#B0C4DE">
	<table width='90%' height='100%' align='center' border='0'>
		<tr>
			<td align="center" style="font-family: arial; font-size: 24px; font-weight: bold;" colspan="2">
				Connect Printer To Workstation
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				Select building:
			</td>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				<select name="lst_building" id="lst_building" onchange="vbs:PopulateFloors">
					<option id="opt_building_select" value="Select building...">Select building...</option>
				</select>
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				Select floor:
			</td>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				<select name="lst_floor" id="lst_floor" onchange="vbs:PopulatePrinters">
					<option id="opt_floor_select" value="Select floor...">Select floor...</option>
				</select>
			</td>
		</tr>
		<tr>
			<td align='left' style="font-family: arial; font-size: 16px; font-weight: bold;">
				Select printer:
			</td>
			<td align='left' style="font-family: arial; 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">
				<input type="checkbox" id="chk_default" name="chk_default">&nbsp;Set selected printer as the default printer
				<br><br><input type="button" value="Add Printer" name="btn_addprinter"  onClick="vbs:Add_Printer" style="font-size: 16px;"><br><br>
			</td>
		</tr>
		<tr>
			<td align='center' colspan="2">
				<span id="span_progress"><br></span>
			</td>
		</tr>
	</table>
</body>
</html>

Open in new window

0
 
LVL 14

Author Comment

by:Dhiraj Mutha
ID: 23677913
This works superb fine. Thanks for your one more help. I made some changes in my script to show it on the top.
0
 
LVL 14

Author Closing Comment

by:Dhiraj Mutha
ID: 31547932
Thanks for the help.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23677972
Great! Thanks for the grade.

Regards,

Rob.
0
 
LVL 14

Author Comment

by:Dhiraj Mutha
ID: 23678036
Rob, small help on the same.

How do i convert this,

MsgBox "You don't have access to the Printer or Its not able to contact the Print Server" & Vbcrlf & "                  Please contact HSCIT Helpdesk @ 68100 for assistance."

to this

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

I am not able to add Vbcrlf.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23678079
See if this works.

Regards,

Rob.
MsgBox "      objFile.Write ""You don't have access to the Printer or Its not able to contact the Print Server"" & VbCrLf & ""                  Please contact HSCIT Helpdesk @ 68100 for assistance."""

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 23678083
Ooops, use this....
objScript.WriteLine "      objFile.Write ""You don't have access to the Printer or Its not able to contact the Print Server"" & VbCrLf & ""                  Please contact HSCIT Helpdesk @ 68100 for assistance."""

Open in new window

0
 
LVL 14

Author Comment

by:Dhiraj Mutha
ID: 23678656
Thanks a lot, that works super fine.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this article we want to have a look at the directory attributes which are used by Microsoft to store the so called Security Identifiers (SID). These SIDs plays an important role in delegating and granting permissions and in authentication of trus…
Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
In a question here at Experts Exchange (https://www.experts-exchange.com/questions/29062564/Adobe-acrobat-reader-DC.html), a member asked how to create a signature in Adobe Acrobat Reader DC (the free Reader product, not the paid, full Acrobat produ…
The Relationships Diagram is a good way to get an overall view of what a database is keeping track of. It is also where relationships are defined. A relationship specifies how two tables connect to each other. As you build tables in Microsoft Ac…

581 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question