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>