Link to home
Start Free TrialLog in
Avatar of Ivano Viola
Ivano ViolaFlag for United States of America

asked on

Query Excel HTA

Hi,

I would like some help updating the below HTA. The script queries an excel spreadsheet for printers and returns the search results in a list box. The list box shows the printer names. In the spreadsheet the IP addresses are in column A and the names in Column B. I would like to update the script so that when you select the returned printer name in the list box and hit "Go", the script reads column A for the address of the selected printer and displays the printers' webpage in the iFrame below. I know the the script could probably be cleaned up a bit. :)

Thanks for taking the time to read my post.

IV

<html>

<head>
<title>Printer Lookup</title>
<HTA:APPLICATION
  APPLICATIONNAME="Printer Lookup"
  BORDER="thin"
  SINGLEINSTANCE="yes"/>
</head>

<BODY scroll="no">

<style type="text/css">
.SelectBox {
	width: 250px;
}
</style>

<table width="605" border="0" cellspacing="0" cellpadding="0">
  <tr>
    <td width="300"><input type="text" id="UserInput" onmousedown="hide()" name="UserInputQuery" size="50"></td>
    <td width="16"><img src="Space.png" alt="" width="16" height="16"></td>
    <td width="76"><input type="button" value="Run Query" name="runQueryButton" onClick="vbs:QueryDatabase"></td>
    <td width="16"><img src="Space.png" alt="" width="16" height="16"></td>
    <td width="48"><Button onclick="vbs:btnBack">
       &lt; Back</Button></td>
    <td width="4"><img src="Space.png" alt="" width="16" height="16"></td>
    <td width="145">
      <input type="button" value="  Exit  " name="exitButton"  onClick="vbs:ExitHTA"></td>
  </tr>
  <tr>
    <td colspan="7"><img src="Space.png" alt="" width="16" height="16"></td>
  </tr>
  <tr>
    <td colspan="7"><table id="Main" style="display:none" width="500" border="0" cellspacing="0" cellpadding="0">
      <tr>
        <td width="39"><select class="SelectBox" size="7" width="30" name="AvailableComputers"></select></td>
        <td width="16" valign="top"><img src="Space.png" alt="" width="16" height="16"></td>
        <td width="39" valign="top"><input type="button" value=" Go " name="Go" onClick="vbs:PerformAction"></td>
        <td width="406" colspan="3" valign="top"><textarea style="visibility:hidden;" name="outputArea" rows="1" cols="1"></textarea></td>
      </tr>
    </table></td>
  </tr>
  <tr>
    <td colspan="7"><img src="Space.png" alt="" width="16" height="16"></td>
  </tr>
  <tr>
    <td colspan="7"></td>
  </tr>
  </table>
  
<IFRAME ID="frmClient"
TRUSTED="yes"
WIDTH="100%"
HEIGHT="90%"
>
</IFRAME>

<script language="javascript"> 
function toggle() {
	var ele = document.getElementById("Main");

	if(ele.style.display == "block") {
    		ele.style.display = "none";
  	}
	else {
		ele.style.display = "block";
	}
}

function hide()
{
var ele2 = document.getElementById("Main");
if(ele2.style.display == "block") {
    		ele2.style.display = "none";
  	}
}

function Show()
{
var ele2 = document.getElementById("Main");
if(ele2.style.display == "none") {
    		ele2.style.display = "block";
  	}
}
        
</script>

<script language="VBScript">

Sub Window_OnLoad
  
  '**** Run startup commands ====
  UserInputQuery.Focus
  
End Sub

'-----------------------------------------------------------------------

Const xlUpdateLinksUserSetting = 1
Const xlUpdateLinksNever = 2
Const xlUpdateLinksAlways = 3

Sub QueryDatabase
  
  If UserInputQuery.Value = "" Then
    MsgBox "Please enter a search term."
    UserInputQuery.Focus
    Exit Sub
  End If
  
  ' Clear search field
  For Each objOption In AvailableComputers.Options
    objOption.RemoveNode
  Next
  
  outputArea.Value = ""
  
  Dim strfind
  Dim strComputer
  Dim testValue
  Dim objExcel
  Dim objWorkbook
  Dim intRow
  Dim intColumn
  Dim strExcel
  Dim matchArray(10)
  Dim intCount
  Dim outputBox
  
  'Initialize all variables
  strComputer = "."
  strfind = UCase(UserInputQuery.Value)
  strFile = "D:\masterlist.xlsx"
  strExcel = UCase(strFile)
  Set objExcel = CreateObject("Excel.Application")
  
  'Refresh database
  objExcel.Visible = False
  objExcel.Application.DisplayAlerts = False
  Set objWB = objExcel.Workbooks.Open(strExcel, xlUpdateLinksAlways, False)
  Set objSheet = objWB.Sheets(1)
  objWB.RefreshAll
  
  'Looping through each column from 2 to 7, for each row up to 500.
  'Assigning the contents of each evaluated cell to a variable called
  'testValue. TestValue is then compared against strfind, the input string
  'if a match is found, the row is recorded in matchArray, the counter that
  'denotes the index for matchArrays storage locations is incremented, and
  'the loop repeats.
  
  Dim FoundCell
  Dim LastCell
  Dim FirstAddr
  Dim strRange
  
  strStartCol = "A"
  intStartRow = 2
  strEndOfRange = Replace(Split(objSheet.UsedRange.Address, ":")(1), "$", "")
  strRange = strStartCol & intStartRow & ":" & strEndOfRange
  intCount = 0
  
  With objSheet.Range(strRange)
	        Set LastCell = .Cells(.Cells.Count)
	    End With
	    Set FoundCell = objSheet.Range(strRange).Find(strfind, LastCell)
	    If Not FoundCell Is Nothing Then
	        FirstAddr = FoundCell.Address
	    End If
	    Do Until FoundCell Is Nothing
	        intCount = intCount + 1
	        'MsgBox FoundCell
			outputArea.Value = outputArea.Value & objSheet.Cells(FoundCell.Row, 2).Value & vbCr '& " " & objSheet.Cells(FoundCell.Row, 4).Value & vbCr
	        Set FoundCell = objSheet.Range(strRange).FindNext(FoundCell)
	        If FoundCell.Address = FirstAddr Then
	            Exit Do
	        End If
	    Loop
	    
  If intCount = 0 Then
    MsgBox "No matches were found."
    UserInputQuery.value = ""
  End If
  
  objWB.Saved = True
  objWB.Close True
  objExcel.Quit
  Populate()
  
End Sub

'-----------------------------------------------------------------------

Sub Populate
  
  arrInputLines=Split(outputArea.value,vbCrLf)
  For Each strLine In arrInputLines
    Set objOption = Document.createElement("OPTION")
    objOption.Text = strLine
    objOption.Value = strLine
    AvailableComputers.Add(objOption)
    UserInputQuery.value = ""
    show()
  Next
  
End Sub

'-----------------------------------------------------------------------

Sub PerformAction
  
  For Each objOption In AvailableComputers.Options
    If objOption.Selected = True Then
      strSelection = objOption.Value
    End If
  Next
  hide()
  strAddress = "http://" & strSelection
  frmClient.document.location.href = strAddress
  
End Sub

'-----------------------------------------------------------------------

Sub btnBack

show()
  
End Sub
      
'-----------------------------------------------------------------------

Sub ExitHTA
  
  Self.Close()
  
End Sub

'-----------------------------------------------------------------------

</script>
</body>
</html>
                                            

Open in new window

masterlist.xlsx
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Ivano Viola

ASKER

Hi Rob,

Thanks for the response and update to the HTA. You addition works great. I appreciate the work and help.

IV
No problem. Glad to help.

Rob.