Listbox in VBScript

Hi,

I am looking for a help in VBScript Listbox. I have a excel sheet with 5 columns

First Column: Hostname
Second Column: MS Patch Name
Third column: Applicable (Y/N)
Fourth Column: Installed (y/N)
Fifth column: Exceptions

What i am looking is that to create an HTA with two list boxes and display the first and the second column data in it. But what is happening here is the data is getting displayed but with the header and duplicate records, that my first problem.

Second, once the listboxes are perfect i should have an option to select two or more that two hostnames and compare them in the same HTA window.

If we cannot do that then is it possible to just display the comparision of the excel data into HTA with proper formatting.
LVL 14
Dhiraj MuthaLevel DAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

aikimarkCommented:
please post what you have done
NorieAnalyst Assistant Commented:
What's the Excel link?

Is the data for the HTA/listbox coming from Excel?
Dhiraj MuthaLevel DAuthor Commented:
The excel file is saved in C drive.  yes the data is for HTA-Listbox.
Bootstrap 4: Exploring New Features

Learn how to use and navigate the new features included in Bootstrap 4, the most popular HTML, CSS, and JavaScript framework for developing responsive, mobile-first websites.

SiddharthRoutCommented:
Can I see a sample file with sample data?

Sid
Dhiraj MuthaLevel DAuthor Commented:
Hi SiddharthRout,

Please find the attached file.


test.csv
Dhiraj MuthaLevel DAuthor Commented:
Jostrander will you be able to look into this?
aikimarkCommented:
@pspglb

Please post the hta code you have written.
Dhiraj MuthaLevel DAuthor Commented:
Please find the code below... now i have started getting an error invalid argument. Please help.
<html>
<head>
</head>
<body>

<script type="text/vbscript">

Sub FillListbox

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\TEST.csv")
intRow = 1

Do Until objExcel.Cells(intRow,1).Value = ""
Set objOption = Document.createElement("OPTION")
		Dim Value
		Value=objExcel.Cells(intRow,1).Value
		'Msgbox Value
	For i=0  to 50
	Msgbox AvailableOptions.value
	If AvailableOptions.value = value then
		Exit For
	Else		
        objOption.Text = objExcel.Cells(intRow, 1).Value
        objOption.Value = objExcel.Cells(intRow, 1).Value
	End if
		AvailableOptions.Add(objOption)
		intRow = intRow + 1
	Next

Loop

objExcel.Quit

End Sub 


Sub ClearListbox
    For Each objOption in AvailableOptions.Options
        objOption.RemoveNode
    Next 
End Sub


</script>

<body bgcolor="palegreen">
<select size="8" name="AvailableOptions" style="width:400">
</select>

<p>
<input id=ronebutton  class="button" type="button" value="Clear Listbox" 
name="one_button"  onClick="ClearListbox"><p>

<p>
<input id=twobutton  class="button" type="button" value="Refill Listbox" name="two_button"  onClick="FillListbox"><p></body>
</html>

Open in new window

aikimarkCommented:
I'm headed to bed.  I expect that sid will post code that uses ADO to get the data from Excel, rather than using Excel automation.

For that matter, a CSV file can also be read (line-by-line) and parsed with the SPLIT() function.
aikimarkCommented:
This code will load the unique Sales column values.  You can replicate this for the Modulename column.
<html>
<head>
</head>
<body>

<script type="text/vbscript">

Sub FillListbox

dim con, rs, objOption 

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\\Users\\Mark\\Downloads\\" & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Store from " & "TEST.csv", con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing

End Sub 


Sub ClearListbox
    For Each objOption in AvailableOptions.Options
        objOption.RemoveNode
    Next 
End Sub


</script>

<body bgcolor="palegreen">
<select size="8" name="AvailableOptions" style="width:400">
</select>

<p>
<input id=ronebutton  class="button" type="button" value="Clear Listbox" 
name="one_button"  onClick="ClearListbox"><p>

<p>
<input id=twobutton  class="button" type="button" value="Refill Listbox" name="two_button"  onClick="FillListbox"><p></body>
</html>

Open in new window

Dhiraj MuthaLevel DAuthor Commented:
That was perfect... Now can you help me in comparing it now? I need to select two or more systems from the first listbox and then select any given patches from the second listbox and display the comparsion on the basis of rest of the field from the excel sheet. If none of the patches from the second listbox selected then show the comparision with all the patches.

Available |Applicable |Grouplist |Groupexclude

I have changed the code and updated here.
<html>
<head>
</head>
<body>

<script type="text/vbscript">

Sub FillListbox

dim con, rs, objOption 

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "d:\\" & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Store from " & "TEST.csv", con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing

End Sub 


Sub FillListbox2

dim con, rs, objOption 

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "d:\\" & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Modulename from " & "TEST.csv", con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions2.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing

End Sub 


Sub ClearListbox
    For Each objOption in AvailableOptions.Options
        objOption.RemoveNode
    Next 
For Each objOption in AvailableOptions2.Options
        objOption.RemoveNode
    Next
End Sub


</script>

<body bgcolor="palegreen">
<select size="8" name="AvailableOptions" style="width:400">
</select>
<select size="8" name="AvailableOptions2" style="width:400">
</select>


<p>
<input id=twobutton  class="button" type="button" value="Refill Listbox" name="two_button"  onClick="FillListbox">
<input id=twobutton2  class="button" type="button" value="Refill Listbox2" name="two_button2"  onClick="FillListbox2">
<input id=ronebutton  class="button" type="button" value="Clear Listbox" name="one_button"  onClick="ClearListbox"><p>
</body>
</html>

Open in new window

aikimarkCommented:
I assume you want the population of the second listbox to be limited to the STORE value selected in the first listbox?

If so, then add another listbox and code that will populate it.

The SQL will change to reflect the use of the
Note: selectedstorevalue represents a variable that contains the value of the selected AvailableOptions listbox

======
I'm not really sure what you want.  Why have two listboxes?  Why not just populate a single listbox with the unique Store|Modulename combinations?

The listing of additional data, based on user selection, would also be similar to the SQL in the code snippet below -- selecting the desired slice of CSV rows.

Please refer to the data as CSV, rather than Excel.


rs.open "select Distinct Modulename from " & "TEST.csv" & " Where Store = '" & selectedstorevalue & "'", con, 3, 3

Open in new window

Dhiraj MuthaLevel DAuthor Commented:
No I want to output a comparsion sheet in the same HTA. If you see the excel sheet you will find this:

Store       Modulename      Available      Applicable to store      Grouplist      Groupexclude


So, the first listbox displayes the Store and the second listbox will diplay the Modulename that we got it. Now what I want is when I multi select storenames from the first listbox and then multi select the modulenames from the second listbox and click on a button it should display me an output comparing the store name and modulename based on the remaining fields (Available      Applicable to store      Grouplist      Groupexclude) in the same HTA window, its fine if the output is in a different HTA.
Dhiraj MuthaLevel DAuthor Commented:
The output should be like the attached file (but not in excel, should be in the same HTA).
Book1.xls
aikimarkCommented:
* you aren't comparing anything (either your description is wrong or your workbook example is inaccurate)

* Since you only have two STORE values, I can't tell what you are trying to do.  It looks like you have selected two Modulename values and are reporting (listing) everything for those two.
Dhiraj MuthaLevel DAuthor Commented:
The data in the excel sheet is just a sample. There will be different storenames and different modulenames. What I just want is, to compare is the data in the excel sheet as per my inputs from the HTA. Suppose you select 2 store names (it can be more than two) and  then we select 2 module names (it also can be more than two or all of them) and then click on a button which will output me the previously attached excel sheet (BOOK1.xls, here xls sheet is just an example, i am looking for an output in HTA or HTML) into the HTA.
aikimarkCommented:
@pspglb

What kind of comparison the code is supposed to be doing?
Dhiraj MuthaLevel DAuthor Commented:
Just the display... as per the xl sheet attached (Book1.xls).... I want to just display the output thats it.
Dhiraj MuthaLevel DAuthor Commented:
This may help.
Book1.xls
aikimarkCommented:
How close is this?

<html>
<head>
</head>
<body>

<script type="text/vbscript">

Sub FillListbox

dim con, rs, objOption 

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\\Users\\Mark\\Downloads\\" & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Store from " & "TEST.csv", con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing

End Sub 


Sub FillListbox2

dim con, rs, objOption 

ClearListbox

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\\Users\\Mark\\Downloads\\" & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Modulename from " & "TEST.csv", con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions2.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing

End Sub 

Sub FillBothListboxes

dim con, rs, objOption 

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\\Users\\Mark\\Downloads\\" & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Store from " & "TEST.csv", con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions.Add(objOption)
  rs.movenext
Loop

rs.close
rs.open "select Distinct Modulename from " & "TEST.csv", con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions2.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing

End Sub 

Sub ClearListbox
    For Each objOption in AvailableOptions.Options
        objOption.RemoveNode
    Next 
    For Each objOption in AvailableOptions2.Options
        objOption.RemoveNode
    Next
End Sub

Sub TestOutput()
  For Each objOption In AvailableOptions.Options
    If objOption.Selected Then
      If Len(strSelectedStores) <> 0 Then
        strSelectedStores = strSelectedStores & ","
      End If
      strSelectedStores = strSelectedStores & "'" & objOption.Value & "'"
    End If
  Next
  
  For Each objOption In AvailableOptions2.Options
    If objOption.Selected Then
      If Len(strSelectedModules) <> 0 Then
        strSelectedModules = strSelectedModules & ","
      End If
      strSelectedModules = strSelectedModules & "'" & objOption.Value & "'"
    End If
  Next
  
  Set con = CreateObject("adodb.connection")
  Set rs = CreateObject("adodb.recordset")
  con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\\Users\\Mark\\Downloads\\" & ";Extended Properties=""text;HDR=Yes;"""
  rs.Open "select Modulename,Store,Available,[Applicable to store],Grouplist,Groupexclude from " & "TEST.csv" & _
            " Where Modulename In (" & strSelectedModules & ") And Store In (" & strSelectedStores & ") Order By Modulename, Store", con, 3, 3

  strOut = "<Table border=""2"">"
  strOut = strOut & "<tr><b>"

  strOut = strOut & "<th>Modulename</th>"
  strOut = strOut & "<th>Store</th>"
  strOut = strOut & "<th>Available</th>"
  strOut = strOut & "<th>Applicable</th>"
  strOut = strOut & "<th>Grouplist</th>"
  strOut = strOut & "<th>GroupExclude</th>"
  strOut = strOut & "</b></tr>"

  Do Until rs.EOF
    strOut = strOut & "<tr><td>" & rs.fields("Modulename") & "</td><td>" & rs.fields("Store") & "</td><td>" & rs.fields("Available") & "</td><td>" & rs.fields("Applicable to store") & "</td><td>" & rs.fields("Grouplist") & "</td><td>" & rs.fields("Groupexclude") & "</td></tr>"
    rs.MoveNext
  Loop
  
  strOut = strOut & "</Table>"
  
  
  output_area.innerHTML = strOut
End Sub

</script>

<body bgcolor="palegreen">
<select size="8" name="AvailableOptions" style="width:400" multiple="multiple">
</select>
<select size="8" name="AvailableOptions2" style="width:400" multiple="multiple">
</select>


<p>
<input id=twobutton  class="button" type="button" value="Refill Listbox" name="two_button"  onClick="FillListbox">
<input id=twobutton2  class="button" type="button" value="Refill Listbox2" name="two_button2"  onClick="FillListbox2">
<input id=ronebutton  class="button" type="button" value="Clear Listbox" name="one_button"  onClick="ClearListbox"><p>
<input id=cmdFillBoth  class="button" type="button" value="Fill Both Listboxes" name="cmdFillBoth"  onClick="FillBothListboxes"><p>
<input id=cmdTestOut  class="button" type="button" value="Output" name="cmdTestOut"  onClick="TestOutput"><p>

<div id=output_area></div>

</body>
</html>

Open in new window

aikimarkCommented:
This version of the script implements intelligent row-spanning for the modulename cells.

<html>
<head>
</head>
<body>

<script type="text/vbscript">

Sub FillListbox

dim con, rs, objOption 

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\\Users\\Mark\\Downloads\\" & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Store from " & "TEST.csv", con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing

End Sub 


Sub FillListbox2

dim con, rs, objOption 

ClearListbox

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\\Users\\Mark\\Downloads\\" & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Modulename from " & "TEST.csv", con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions2.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing

End Sub 

Sub FillBothListboxes

dim con, rs, objOption 

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\\Users\\Mark\\Downloads\\" & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Store from " & "TEST.csv", con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions.Add(objOption)
  rs.movenext
Loop

rs.close
rs.open "select Distinct Modulename from " & "TEST.csv", con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions2.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing

End Sub 

Sub ClearListbox
    For Each objOption in AvailableOptions.Options
        objOption.RemoveNode
    Next 
    For Each objOption in AvailableOptions2.Options
        objOption.RemoveNode
    Next
End Sub

Sub TestOutput()
  For Each objOption In AvailableOptions.Options
    'strOut = strOut & "STORE: " & objOption.value & " " & objOption.Selected & "<BR>"
  
    If objOption.Selected Then
      If Len(strSelectedStores) <> 0 Then
        strSelectedStores = strSelectedStores & ","
      End If
      strSelectedStores = strSelectedStores & "'" & objOption.Value & "'"
    End If
  Next
  
  For Each objOption In AvailableOptions2.Options
    'strOut = strOut & "MOD: " & objOption.value & " " & objOption.Selected & "<BR>"
    If objOption.Selected Then
      If Len(strSelectedModules) <> 0 Then
        strSelectedModules = strSelectedModules & ","
      End If
      strSelectedModules = strSelectedModules & "'" & objOption.Value & "'"
    End If
  Next
  
  Set con = CreateObject("adodb.connection")
  Set rs = CreateObject("adodb.recordset")
  con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\\Users\\Mark\\Downloads\\" & ";Extended Properties=""text;HDR=Yes;"""
  rs.Open "select Modulename,Store,Available,[Applicable to store],Grouplist,Groupexclude from " & "TEST.csv" & _
            " Where Modulename In (" & strSelectedModules & ") And Store In (" & strSelectedStores & ") Order By Modulename, Store", con, 3, 3
  
  If rs.EOF Then
    MsgBox "No rows for the selected Store/Module combination"
    Exit Sub
  Else
    Set rsgroup = CreateObject("adodb.recordset")
    rsgroup.Open "Select Modulename, Count(Store) As RowSpan from " & "TEST.csv" & _
            " Where Modulename In (" & strSelectedModules & ") And Store In (" & strSelectedStores & ") Group By Modulename", con, 3, 3
  End If

  strOut = "<Table border=""2"">"
  strOut = strOut & "<tr><b>"

  strOut = strOut & "<th>Modulename</th>"
  strOut = strOut & "<th>Store</th>"
  strOut = strOut & "<th>Available</th>"
  strOut = strOut & "<th>Applicable</th>"
  strOut = strOut & "<th>Grouplist</th>"
  strOut = strOut & "<th>GroupExclude</th>"
  strOut = strOut & "</b></tr>"

  Do Until rs.EOF
    If strPriorModule <> rs.Fields("Modulename") Then
      strPriorModule = rs.Fields("Modulename")
      Do Until rsgroup.Fields("Modulename") = strPriorModule
        rsgroup.MoveNext
      Loop
      strOut = strOut & "<tr><td rowspan=" & Chr(34) & rsgroup.fields("RowSpan") & Chr(34) & ">" & rs.Fields("Modulename") & "</td>"
    End If
    strOut = strOut & "<td>" & rs.Fields("Store") & "</td><td>" & rs.Fields("Available") & "</td><td>" & rs.Fields("Applicable to store") & "</td><td>" & rs.Fields("Grouplist") & "</td><td>" & rs.Fields("Groupexclude") & "</td></tr>"
    rs.MoveNext
  Loop
  
  strOut = strOut & "</Table>"
  
  output_area.innerHTML = strOut

  set rs = nothing
  set rsgroup =  nothing
  set con = nothing

End Sub


</script>

<body bgcolor="palegreen">
<select size="8" name="AvailableOptions" style="width:400" multiple="multiple">
</select>
<select size="8" name="AvailableOptions2" style="width:400" multiple="multiple">
</select>


<p>
<input id=twobutton  class="button" type="button" value="Refill Listbox" name="two_button"  onClick="FillListbox">
<input id=twobutton2  class="button" type="button" value="Refill Listbox2" name="two_button2"  onClick="FillListbox2">
<input id=ronebutton  class="button" type="button" value="Clear Listbox" name="one_button"  onClick="ClearListbox"><p>
<input id=cmdFillBoth  class="button" type="button" value="Fill Both Listboxes" name="cmdFillBoth"  onClick="FillBothListboxes"><p>
<input id=cmdTestOut  class="button" type="button" value="Output" name="cmdTestOut"  onClick="TestOutput"><p>

<div id=output_area></div>

</body>
</html>

Open in new window

RobSampsonCommented:
Guys, I'm not really sure what's going on here, but if I could make one improvement to aikimark's latest code, I have put the CSV path reference at the top, in one spot, and the ADO connections now read from that location....

I will try to follow what's going on....
<html>
<head>
<script language="vbscript" type="text/vbscript">

Dim strFilePath
Dim strPath, strFile

Sub Window_OnLoad
	strFilePath = "C:\Temp\Temp\Test Script\Test.CSV"
	strPath = Left(strFilePath, InStrRev(strFilePath, "\"))
	strFile = Mid(strFilePath, InStrRev(strFilePath, "\") + 1)
End Sub

Sub FillListbox

dim con, rs, objOption 

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Replace(strPath, "\", "\\") & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Store from " & strFile, con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing

End Sub 


Sub FillListbox2

dim con, rs, objOption 

ClearListbox

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Replace(strPath, "\", "\\") & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Store from " & strFile, con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions2.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing

End Sub 

Sub FillBothListboxes

dim con, rs, objOption 

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Replace(strPath, "\", "\\") & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Store from " & strFile, con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions.Add(objOption)
  rs.movenext
Loop

rs.close
rs.open "select Distinct Modulename from " & "TEST.csv", con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions2.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing

End Sub 

Sub ClearListbox
    For Each objOption in AvailableOptions.Options
        objOption.RemoveNode
    Next 
    For Each objOption in AvailableOptions2.Options
        objOption.RemoveNode
    Next
End Sub

Sub TestOutput()
  For Each objOption In AvailableOptions.Options
    'strOut = strOut & "STORE: " & objOption.value & " " & objOption.Selected & "<BR>"
  
    If objOption.Selected Then
      If Len(strSelectedStores) <> 0 Then
        strSelectedStores = strSelectedStores & ","
      End If
      strSelectedStores = strSelectedStores & "'" & objOption.Value & "'"
    End If
  Next
  
  For Each objOption In AvailableOptions2.Options
    'strOut = strOut & "MOD: " & objOption.value & " " & objOption.Selected & "<BR>"
    If objOption.Selected Then
      If Len(strSelectedModules) <> 0 Then
        strSelectedModules = strSelectedModules & ","
      End If
      strSelectedModules = strSelectedModules & "'" & objOption.Value & "'"
    End If
  Next
  
  Set con = CreateObject("adodb.connection")
  Set rs = CreateObject("adodb.recordset")
  con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Replace(strPath, "\", "\\") & ";Extended Properties=""text;HDR=Yes;"""
  rs.Open "select Modulename,Store,Available,[Applicable to store],Grouplist,Groupexclude from " & strFile & _
            " Where Modulename In (" & strSelectedModules & ") And Store In (" & strSelectedStores & ") Order By Modulename, Store", con, 3, 3
  
  If rs.EOF Then
    MsgBox "No rows for the selected Store/Module combination"
    Exit Sub
  Else
    Set rsgroup = CreateObject("adodb.recordset")
    rsgroup.Open "Select Modulename, Count(Store) As RowSpan from " & "TEST.csv" & _
            " Where Modulename In (" & strSelectedModules & ") And Store In (" & strSelectedStores & ") Group By Modulename", con, 3, 3
  End If

  strOut = "<Table border=""2"">"
  strOut = strOut & "<tr><b>"

  strOut = strOut & "<th>Modulename</th>"
  strOut = strOut & "<th>Store</th>"
  strOut = strOut & "<th>Available</th>"
  strOut = strOut & "<th>Applicable</th>"
  strOut = strOut & "<th>Grouplist</th>"
  strOut = strOut & "<th>GroupExclude</th>"
  strOut = strOut & "</b></tr>"

  Do Until rs.EOF
    If strPriorModule <> rs.Fields("Modulename") Then
      strPriorModule = rs.Fields("Modulename")
      Do Until rsgroup.Fields("Modulename") = strPriorModule
        rsgroup.MoveNext
      Loop
      strOut = strOut & "<tr><td rowspan=" & Chr(34) & rsgroup.fields("RowSpan") & Chr(34) & ">" & rs.Fields("Modulename") & "</td>"
    End If
    strOut = strOut & "<td>" & rs.Fields("Store") & "</td><td>" & rs.Fields("Available") & "</td><td>" & rs.Fields("Applicable to store") & "</td><td>" & rs.Fields("Grouplist") & "</td><td>" & rs.Fields("Groupexclude") & "</td></tr>"
    rs.MoveNext
  Loop
  
  strOut = strOut & "</Table>"
  
  output_area.innerHTML = strOut

  set rs = nothing
  set rsgroup =  nothing
  set con = nothing

End Sub
</script>
</head>
<body bgcolor="palegreen">
<select size="8" name="AvailableOptions" style="width:400" multiple="multiple">
</select>
<select size="8" name="AvailableOptions2" style="width:400" multiple="multiple">
</select>


<p>
<input id=twobutton  class="button" type="button" value="Refill Listbox" name="two_button"  onClick="FillListbox">
<input id=twobutton2  class="button" type="button" value="Refill Listbox2" name="two_button2"  onClick="FillListbox2">
<input id=ronebutton  class="button" type="button" value="Clear Listbox" name="one_button"  onClick="ClearListbox"><p>
<input id=cmdFillBoth  class="button" type="button" value="Fill Both Listboxes" name="cmdFillBoth"  onClick="FillBothListboxes"><p>
<input id=cmdTestOut  class="button" type="button" value="Output" name="cmdTestOut"  onClick="TestOutput"><p>

<div id=output_area></div>

</body>
</html>

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
aikimarkCommented:
@Rob

Thanks.  That will make it easier to develop.
Dhiraj MuthaLevel DAuthor Commented:
You guys are genius.... superb.... you know, you have just saved my job.... Thanks a lot for all the efforts and help.
RobSampsonCommented:
I probably shouldn't have received any points for that one....it was a simple change....aikimark, if you're unhappy with the closure, I'm fine with you requesting it to be changed....

Rob.
aikimarkCommented:
@Rob

I think the points are fine the way they are.

Merry Christmas
Mark
Dhiraj MuthaLevel DAuthor Commented:
I am really sorry for this... if you want I will get it changed.
RobSampsonCommented:
No, it's no problem for me, and Mark said he's fine with it, so it's OK.  I'm happy to help, he did all the work though.  But nevermind.  Have a great holiday season everyone!

Regards,

Rob.
Dhiraj MuthaLevel DAuthor Commented:
Same to you and Happy Holiday and Happy New Year.

Below is the final code, I have modified. Also one last question to change the colour of the modulenames in output, which line I have to modify?


<html>
<head>
<title>Module Comparsion</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Module Comparsion"
     SCROLL="yes"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="maximize"
     ContextMenu="no"
>
</head>

<script language="VBScript">

Dim strFilePath
Dim strPath, strFile

Sub Window_OnLoad
cmdTestOut.disabled=true
End Sub
 

Sub FillBothListboxes
If ExcelFile.value="" then
Msgbox "Please select an appropriate file"
Else
Dim con, rs, objOption 

strFilePath = ExcelFile.value
'strFilePath = "d:\Test.CSV"
strPath = Left(strFilePath, InStrRev(strFilePath, "\"))
strFile = Mid(strFilePath, InStrRev(strFilePath, "\") + 1)

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Replace(strPath, "\", "\\") & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Store from " & strFile, con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions.Add(objOption)
  rs.movenext
Loop

rs.close
rs.open "select Distinct Modulename from " & "TEST.csv", con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions2.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing
cmdTestOut.disabled=false
End if
End Sub 

Sub ResetAll
    Location.Reload(True)
End Sub

Sub TestOutput()
  For Each objOption In AvailableOptions.Options
    'strOut = strOut & "STORE: " & objOption.value & " " & objOption.Selected & "<BR>"
  
    If objOption.Selected Then
      If Len(strSelectedStores) <> 0 Then
        strSelectedStores = strSelectedStores & ","
      End If
      strSelectedStores = strSelectedStores & "'" & objOption.Value & "'"
    End If
  Next
  
  For Each objOption In AvailableOptions2.Options
    'strOut = strOut & "MOD: " & objOption.value & " " & objOption.Selected & "<BR>"
    If objOption.Selected Then
      If Len(strSelectedModules) <> 0 Then
        strSelectedModules = strSelectedModules & ","
      End If
      strSelectedModules = strSelectedModules & "'" & objOption.Value & "'"
    End If
  Next
  
  Set con = CreateObject("adodb.connection")
  Set rs = CreateObject("adodb.recordset")
  con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Replace(strPath, "\", "\\") & ";Extended Properties=""text;HDR=Yes;"""
  rs.Open "select Modulename,Store,Available,[Applicable to store],Grouplist,Groupexclude from " & strFile & _
            " Where Modulename In (" & strSelectedModules & ") And Store In (" & strSelectedStores & ") Order By Modulename, Store", con, 3, 3
  
  If rs.EOF Then
    MsgBox "No rows for the selected Store/Module combination"
    Exit Sub
  Else
    Set rsgroup = CreateObject("adodb.recordset")
    rsgroup.Open "Select Modulename, Count(Store) As RowSpan from " & "TEST.csv" & _
            " Where Modulename In (" & strSelectedModules & ") And Store In (" & strSelectedStores & ") Group By Modulename", con, 3, 3
  End If

  strOut = "<Table border=""2"">"
  strOut = strOut & "<tr><b>"
  
  strOut = strOut & "<th>Modulename</th>"
  strOut = strOut & "<th>Store</th>"
  strOut = strOut & "<th>Available</th>"
  strOut = strOut & "<th>Applicable</th>"
  strOut = strOut & "<th>Grouplist</th>"
  strOut = strOut & "<th>GroupExclude</th>"
  strOut = strOut & "</b></tr>"

  Do Until rs.EOF
    If strPriorModule <> rs.Fields("Modulename") Then
      strPriorModule = rs.Fields("Modulename")
      Do Until rsgroup.Fields("Modulename") = strPriorModule
        rsgroup.MoveNext
      Loop
      strOut = strOut & "<tr><td rowspan=" & Chr(34) & rsgroup.fields("RowSpan") & Chr(34) & ">" & rs.Fields("Modulename") & "</td>"
    End If
    strOut = strOut & "<td>" & rs.Fields("Store") & "</td><td>" & rs.Fields("Available") & "</td><td>" & rs.Fields("Applicable to store") & "</td><td>" & rs.Fields("Grouplist") & "</td><td>" & rs.Fields("Groupexclude") & "</td></tr>"
    rs.MoveNext
  Loop
  
  strOut = strOut & "</Table>"
  
  output_area.innerHTML = strOut

  set rs = nothing
  set rsgroup =  nothing
  set con = nothing

End Sub
</script>
<body STYLE="font:14pt Garamond ; color:#347C17; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#6AFB92', EndColorStr='#FFE87C')">
<input type="file" name="ExcelFile" size="75"><br><br>
<select size="8" name="AvailableOptions" style="width:400" multiple="multiple">
</select>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
<select size="8" name="AvailableOptions2" style="width:400" multiple="multiple">
</select>

<input id=cmdFillBoth  class="button" type="button" value="Fill Both Listboxes" name="cmdFillBoth"  onClick="FillBothListboxes">
<input id=ronebutton  class="button" type="button" value="Reset All" name="one_button"  onClick="ResetAll">
<input id=cmdTestOut  class="button" type="button" value="Output To Screen" name="cmdTestOut"  onClick="TestOutput"><br><br><br><br>
<div id=output_area></div>

</body>
</html>

Open in new window

RobSampsonCommented:
Looks like this line:
      strOut = strOut & "<tr><td rowspan=" & Chr(34) & rsgroup.fields("RowSpan") & Chr(34) & ">" & rs.Fields("Modulename") & "</td>"

could be changed to something like this to make the font color "red":
      strOut = strOut & "<tr><td rowspan=" & Chr(34) & rsgroup.fields("RowSpan") & Chr(34) & "><font color='red'>" & rs.Fields("Modulename") & "</font></td>"

Rob.
Dhiraj MuthaLevel DAuthor Commented:
Guys,

Urgent help... I am getting the attached error while running this script.

Once I select the CSV file and select the data in the listbox and click on Fill List Box, I get the attached error.
<html>
<head>
<title>Module Comparsion</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Module Comparsion"
     SCROLL="yes"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="maximize"
     ContextMenu="no"
>
</head>

<script language="VBScript">

'---------------------------------------*
'Created by Dhiraj D. Mutha
'Accenture India - BDC04
'Best Buy - RTI project
'Email: dhiraj.d.mutha@accenture.com
'---------------------------------------*

Dim strFilePath
Dim strPath, strFile

Sub Window_OnLoad
cmdTestOut.disabled=true
End Sub
 

Sub FillBothListboxes
If ExcelFile.value="" then
Msgbox "Please select an appropriate file"
Else
Dim con, rs, objOption 

strFilePath = ExcelFile.value
'strFilePath = "d:\Test.CSV"
strPath = Left(strFilePath, InStrRev(strFilePath, "\"))
strFile = Mid(strFilePath, InStrRev(strFilePath, "\") + 1)

set con = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
con.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Replace(strPath, "\", "\\") & ";Extended Properties=""text;HDR=Yes;"""
rs.open "select Distinct Store from " & strFile, con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions.Add(objOption)
  rs.movenext
Loop

rs.close
rs.open "select Distinct Modulename from " & strFile, con, 3, 3

Do Until rs.EOF
  Set objOption = Document.createElement("OPTION")
  objOption.Text = rs.Fields(0).Value
  objOption.Value = rs.Fields(0).Value

  AvailableOptions2.Add(objOption)
  rs.movenext
Loop

set rs = nothing
set con = nothing
cmdTestOut.disabled=false
End if
End Sub 

Sub ResetAll
    Location.Reload(True)
End Sub

Sub TestOutput()
  For Each objOption In AvailableOptions.Options
    'strOut = strOut & "STORE: " & objOption.value & " " & objOption.Selected & "<BR>"
  
    If objOption.Selected Then
      If Len(strSelectedStores) <> 0 Then
        strSelectedStores = strSelectedStores & ","
      End If
      strSelectedStores = strSelectedStores & "'" & objOption.Value & "'"
    End If
  Next
  
  For Each objOption In AvailableOptions2.Options
    'strOut = strOut & "MOD: " & objOption.value & " " & objOption.Selected & "<BR>"
    If objOption.Selected Then
      If Len(strSelectedModules) <> 0 Then
        strSelectedModules = strSelectedModules & ","
      End If
      strSelectedModules = strSelectedModules & "'" & objOption.Value & "'"
    End If
  Next
  
  Set con = CreateObject("adodb.connection")
  Set rs = CreateObject("adodb.recordset")
  con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Replace(strPath, "\", "\\") & ";Extended Properties=""text;HDR=Yes;"""
  rs.Open "select Modulename,Store,Available,[Applicable to store],Grouplist,Groupexclude from " & strFile & _
            " Where Modulename In (" & strSelectedModules & ") And Store In (" & strSelectedStores & ") Order By Modulename, Store", con, 3, 3
  
  If rs.EOF Then
    MsgBox "No rows for the selected Store/Module combination"
    Exit Sub
  Else
    Set rsgroup = CreateObject("adodb.recordset")
    rsgroup.Open "Select Modulename, Count(Store) As RowSpan from " & "TEST.csv" & _
            " Where Modulename In (" & strSelectedModules & ") And Store In (" & strSelectedStores & ") Group By Modulename", con, 3, 3
  End If

  strOut = "<Table border=""2"">"
  strOut = strOut & "<tr><b>"
  
  strOut = strOut & "<th>Modulename</th>"
  strOut = strOut & "<th>Store</th>"
  strOut = strOut & "<th>Available</th>"
  strOut = strOut & "<th>Applicable</th>"
  strOut = strOut & "<th>Grouplist</th>"
  strOut = strOut & "<th>GroupExclude</th>"
  strOut = strOut & "</b></tr>"

  Do Until rs.EOF
    If strPriorModule <> rs.Fields("Modulename") Then
      strPriorModule = rs.Fields("Modulename")
      Do Until rsgroup.Fields("Modulename") = strPriorModule
        rsgroup.MoveNext
      Loop
      strOut = strOut & "<tr><td rowspan=" & Chr(34) & rsgroup.fields("RowSpan") & Chr(34) & ">" & rs.Fields("Modulename") & "</td>"
    End If
    strOut = strOut & "<td>" & rs.Fields("Store") & "</td><td>" & rs.Fields("Available") & "</td><td>" & rs.Fields("Applicable to store") & "</td><td>" & rs.Fields("Grouplist") & "</td><td>" & rs.Fields("Groupexclude") & "</td></tr>"
    rs.MoveNext
  Loop
  
  strOut = strOut & "</Table>"
  
  output_area.innerHTML = strOut

  set rs = nothing
  set rsgroup =  nothing
  set con = nothing

End Sub
</script>
<body STYLE="font:14pt Garamond ; color:#347C17; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#6AFB92', EndColorStr='#FFE87C')">
<input type="file" name="ExcelFile" size="75"><br><br>
<select size="8" name="AvailableOptions" style="width:400" multiple="multiple">
</select>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
<select size="8" name="AvailableOptions2" style="width:400" multiple="multiple">
</select>

<input id=cmdFillBoth  class="button" type="button" value="Fill Both Listboxes" name="cmdFillBoth"  onClick="FillBothListboxes">
<input id=ronebutton  class="button" type="button" value="Reset All" name="one_button"  onClick="ResetAll">
<input id=cmdTestOut  class="button" type="button" value="Output To Screen" name="cmdTestOut"  onClick="TestOutput"><br><br><br><br>
<div id=output_area></div>

</body>
</html>

Open in new window

test1.csv
error.JPG
Dhiraj MuthaLevel DAuthor Commented:
Hi aikimark,

I have raised a new request. Please help me on the same.

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_26748998.html
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.