Cascading Dropdown List using VBScript, XPATH and an XML back-end

I’ve been working on more toolsets recently, and we needed a way to populate multiple dropdown lists in a HTA file, and make them cascade. Cascading is basically where the results in the second dropdown list are dictated by the selection in the first dropdown list. For example:

Let’s say our first dropdown list contained car manufacturers, and the second dropdown list contained models. If I selected ‘Ford’ from the manufacturers dropdown list, I would want the model dropdown list to show me a list of all cars made by Ford (Fiesta, Mondeo, Escort etc etc) and so on.

Anyway, in our example we’ll use a good ol’ list of football clubs. In dropdown list 1, we want a list of football clubs. And in dropdown list 2, we want to see a list of players. We also want to keep track of the stadium that each clubs plays in. Here’s our sample XML chunk – we’ll call it ‘footballclubs.xml’:

<?xml version="1.0"?>
<PREMIERLEAGUEFOOTBALLCLUBS>
<FOOTBALLCLUBS>
<FOOTBALLCLUB>
<FOOTBALLCLUBNAME>Manchester United FC</FOOTBALLCLUBNAME>
<FOOTBALLCLUBSTADIUM>Old Trafford</FOOTBALLCLUBSTADIUM>
<PLAYERS>				
<PLAYER>
<PLAYERNAME>Rio Ferdinand</PLAYERNAME>
</PLAYER>		
<PLAYER>
<PLAYERNAME>Nemanja Vidic</PLAYERNAME>
</PLAYER>				
</PLAYERS>
</FOOTBALLCLUB>
<FOOTBALLCLUB>
<FOOTBALLCLUBNAME>Chelsea FC</FOOTBALLCLUBNAME>
<FOOTBALLCLUBSTADIUM>Stamford Bridge</FOOTBALLCLUBSTADIUM>
<PLAYERS>				
<PLAYER>
<PLAYERNAME>Frank Lampard</PLAYERNAME>
</PLAYER>				
</PLAYERS>
</FOOTBALLCLUB>
<FOOTBALLCLUB>
<FOOTBALLCLUBNAME>Arsenal FC</FOOTBALLCLUBNAME>
<FOOTBALLCLUBSTADIUM>Emirates Stadium</FOOTBALLCLUBSTADIUM>
<PLAYERS>				
<PLAYER>
<PLAYERNAME>Keiron Gibbs</PLAYERNAME>
</PLAYER>		
<PLAYER>
<PLAYERNAME>Jack Wilshere</PLAYERNAME>
</PLAYER>
<PLAYER>
<PLAYERNAME>Aaron Ramsey</PLAYERNAME>
</PLAYER>				
</PLAYERS>
</FOOTBALLCLUB>		
</FOOTBALLCLUBS>
</PREMIERLEAGUEFOOTBALLCLUBS>

You can see that the football clubs are: Manchester Utd, Chelsea and Arsenal. You should also be able to see the players for each club, and the stadium they play in.

Now we’ll write a HTA file, and save it in the same location as ”footballclubs.xml’:

<html>
<head>
<hta:application
id="oHTA"
applicationname="XML Cascading Drop Down"
singleinstance="yes"
windowstate="normal"
border="no"
maximize="no"
caption="XML Cascading Drop Down"
icon="alkane.ico"
showintaskbar="yes"
sysmenu="yes"> 
<title>XML Cascading Drop Down 1.0.0</title>
</head>
<script language="vbscript">
' *************
'
' Version 1.0.0
'
'**************
Option Explicit
Dim strXMLFile
Sub InitialWindow
Dim intHorizontal, intVertical, intLeft, intTop, objItem	
Dim menu_width : menu_width = "450"
Dim menu_height : menu_height = "420"	
' This moves the window to the middle of the screen
Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") 
Dim colItems : Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor WHERE DeviceID='DesktopMonitor1'") 
For Each objItem in ColItems 
intHorizontal = objItem.ScreenWidth 
intVertical = objItem.ScreenHeight 
Next 
intLeft = (intHorizontal - menu_width)/2 
intTop = (intVertical - menu_height)/2 
window.resizeTo menu_width,menu_height 
window.moveTo intLeft, intTop
strXMLFile = FindCurrentDir & "footballclubs.xml"		
Call PopulateDropdownLists
End Sub
Function FindCurrentDir
Dim objShell : Set objShell = CreateObject("WScript.Shell")
FindCurrentDir = Left(document.location.pathname,InStrRev(document.location.pathname,"\"))
End Function
Sub PopulateDropdownLists
Dim objOption
Dim strQuery, colItem, objItem
Const intForReading = 1
Dim xmlDoc : Set xmlDoc = CreateObject( "Microsoft.XMLDOM" )
xmlDoc.Async = False
If xmlDoc.Load(strXMLFile) Then
'populate club names
Set objOption = Document.createElement("OPTION")
objOption.Text = "Select Club"
objOption.value = "Select Club"
ClubSelector.add(objOption)
strQuery = "/PREMIERLEAGUEFOOTBALLCLUBS/FOOTBALLCLUBS/FOOTBALLCLUB/FOOTBALLCLUBNAME"	
Set colItem = xmlDoc.selectNodes(strQuery)
For Each objItem in colItem	
Set objOption = Document.createElement("OPTION")
objOption.Text = objItem.text
objOption.value = objItem.text
ClubSelector.add(objOption)		
Next
Set objOption = Document.createElement("OPTION")
objOption.Text = "Select Player"
objOption.value = "Select Player"
PlayerSelector.add(objOption)	
End If
Set xmlDoc = Nothing
End Sub
Sub populateClubs()
Dim footballclubname : footballclubname = ClubSelector.options(ClubSelector.SelectedIndex).value
Dim objOption
For Each objOption in PlayerSelector.Options
objOption.RemoveNode
Next 	
Dim xmlDoc : Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = False
Set objOption = Document.createElement("OPTION")
objOption.Text = "Select Player"
objOption.value = "Select Player"
PlayerSelector.add(objOption)
If xmlDoc.Load(strXMLFile) Then
dim strQuery : strQuery = "/PREMIERLEAGUEFOOTBALLCLUBS/FOOTBALLCLUBS/FOOTBALLCLUB [ FOOTBALLCLUBNAME = '" & footballclubname & "' ] /PLAYERS/PLAYER/PLAYERNAME"
dim colItem : Set colItem = xmlDoc.selectNodes(strQuery)
dim objItem
For Each objItem in colItem
Set objOption = Document.createElement("OPTION")
objOption.Text = objItem.text
objOption.value = objItem.text
PlayerSelector.add(objOption)	
Next
End If
Set xmlDoc = Nothing		
End Sub
Function getXMLValues(footballclubname,tag)
Dim xmlDoc : Set xmlDoc = CreateObject( "Microsoft.XMLDOM" )
xmlDoc.Async = False
If xmlDoc.Load(strXMLFile) Then
dim strQuery : strQuery = "/PREMIERLEAGUEFOOTBALLCLUBS/FOOTBALLCLUBS/FOOTBALLCLUB [ FOOTBALLCLUBNAME = '" & footballclubname & "' ] /" & tag & ""
dim colItem : Set colItem = xmlDoc.selectNodes(strQuery)
dim objItem
For Each objItem in colItem
getXMLValues = objItem.text
Next
End If
Set xmlDoc = Nothing	
End Function
Sub displayStadium
Dim footballclubname : footballclubname = ClubSelector.options(ClubSelector.SelectedIndex).value	
Dim stadiumname : stadiumname = getXMLValues(footballclubname,"FOOTBALLCLUBSTADIUM")	
MsgBox stadiumname
End Sub
</script>
<body scroll="no" onload="InitialWindow" style="text-align:center;font-family:Arial;font-size:12px;">
<br /><br />
<select size="1" id="ClubSelector" onChange="populateClubs()"></select><br /><br />
<select size="1" id="PlayerSelector"></select><br /><br />
<input type="button" value="Display Stadium" name="printSelection"  onClick="displayStadium()" />
</div>
</body>
</html>