Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Dynamic listbox not working properly

Posted on 2009-05-06
9
741 Views
Last Modified: 2012-06-21
Experts,

I was previously assisted on this topic, however I've encountered another poblem.

My script pulls a query within AD for a list of users.  It then sorts that list of users alphabetically and puts the sorted items back into the original dictionary.

I am able to post the items to the GUI, but when I begin typing out the name of a person I want to select, the script is removing the incorrect entries.

For example, if I type "Fr", anything that doesn't have (or start with) "Fr" should be removed, and the others should remain.

I've posted my code, any help would be appreciated.
Set objRecordSet = objCommand.Execute
 
	objRecordSet.MoveFirst
 
	Do Until objRecordSet.EOF
 
		'msgbox objRecordSet.Fields("givenName").Value & " " & objRecordSet.Fields("sn").Value
 
		strUserAccount = UCase(objRecordSet.Fields("sAMAccountName").Value)
		strUserEntry = UCase(objRecordSet.Fields("givenName").Value) & " " & UCase(objRecordSet.Fields("sn").Value)
		strUserMail = objRecordSet.Fields("mail").Value
		
		If strUserAccount = "null" OR strUserEntry = "null" OR strUserMail = null then
			'skip record, do nothing
		Else
			dicUserNameList.Add strUserEntry,strUserAccount
		End If
 
		ObjRecordSet.MoveNext
 
	Loop
 
	msgbox "Entries created"
	Set objDictSorted = SortDict(dicUserNameList)
	window.setTimeout "BuildList()",200
End Sub
 
Function SortDict(ByVal objDict)
 
 Dim i, j, temp
 
 For Each i In objDict
  For Each j In objDict
   If(objDict.Item(i) <= objDict.Item(j)) Then
    temp = objDict.Item(i)
    objDict.Item(i) = objDict.Item(j)
    objDict.Item(j) = temp
   End If
  Next
 Next
 
 'For Each i In objDict
  'msgbox objDict.Item(i)
 'Next
 
 Set SortDict = dicUserNameList
 
End Function
 
 
Sub BuildList
 
	For Each strUser in dicUserNameList
			'msgbox strUser & " " & strUserEmail
			Set objOption = Document.createElement("OPTION")
			objOption.Text = dicUserNameList.Item(strUser)
			objOption.Value = dicUserNameList.Item(strUser)
			'msgbox objOption.Text & " " & objOption.Value
			UserNames.Add(objOption)
	Next
 
End Sub
 
Sub CheckValue
 
	msgbox UserNames.Value
 
End Sub
 
Sub CheckKey
	Set objOptions = UserNames.Options
		
	For Each strOption in objOptions
		strOption.RemoveNode
	Next
	
	If EnterName.Value = "" then
		
		For Each strUser in dicUserNameList
			'msgbox strUser & " " & strUserEmail
			Set objOption = Document.createElement("OPTION")
			objOption.Text = dicUserNameList.Item(strUser)
			objOption.Value = dicUserNameList.Item(strUser)			
			'msgbox objOption.Text & " " & objOption.Value
			UserNames.Add(objOption)
		Next
	
	Else 
		
		'For Each strUser in dicUserNameList
		For Each strUser in objDict
		
		strEntryLength = len(EnterName.Value)
		msgbox left(strUser,strEntryLength)
			If left(strUser,strEntryLength) = Ucase(EnterName.Value) then
				Set objOption = Document.createElement("OPTION")
				objOption.Text = dicUserNameList.Item(strUser)
				objOption.Value = dicUserNameList.Item(strUser)
				UserNames.Add(objOption)
			Else
				'Nothing, doesn't match.
			End If
		Next		
	End If
End Sub

Open in new window

0
Comment
Question by:piattnd
  • 5
  • 4
9 Comments
 
LVL 14

Expert Comment

by:rejoinder
ID: 24319139
Can you try this listbox/filter.
It will poll all users and list them in the box.  The listbox automatically sorts the names so you do not need to run additional code for that.  As you type in the lower text box, the names above are checked and filtered.  Double click the name in the listbox to jump to that individual.
<head>
<title>Your-App</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Your-App"
     BORDER="thick"
     SCROLL="yes"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="MAXIMIZE"
     ID="oHTA"
>
<APPLICATION:HTA>
</head>
 
<script language="VBScript">
 
set dicUserNameList = CreateObject("Scripting.Dictionary")
 
Sub Window_OnLoad
    Set objList = document.getElementById( "lst_UserNames" )
    If objList Is Nothing Then
        MsgBox "A problem was encountered while creating the listview." & vbCRLF & "Please see your administrator."
    Else
        With objList
            .View              = 3
            .Width             = 360
            .Height            = 140
            .SortKey           = 0
            .Arrange           = 0
            .LabelEdit         = 1
            .SortOrder         = 0
            .Sorted            = 1
            .MultiSelect       = 0
            .LabelWrap         = -1
            .HideSelection     = -1
            .HideColumnHeaders = 0
            .OLEDragMode       = 0
            .OLEDropMode       = 0
            .Checkboxes        = 0
            .FlatScrollBar     = 0
            .FullRowSelect     = 1
            .GridLines         = 0
            .HotTracking       = 0
            .HoverSelection    = 0
            .PictureAlignment  = 0
            .TextBackground    = 0
            .ForeColor         = -2147483640
            .BackColor         = -2147483643
            .BorderStyle       = 1
            .Appearance        = 1
            .MousePointer      = 0
            .Enabled           = 1
            .ColumnHeaders.Clear
            .ColumnHeaders.Add , , "Users", 200
            .ListItems.Clear
        End With
    End If
    
    Set adoCommand = CreateObject("ADODB.Command") 
    Set adoConnection = CreateObject("ADODB.Connection") 
    adoConnection.Provider = "ADsDSOObject" 
    adoConnection.Open "Active Directory Provider" 
    adoCommand.ActiveConnection = adoConnection 
 
    ' Search entire Active Directory domain. 
    Set objRootDSE = GetObject("LDAP://RootDSE") 
    strDNSDomain = objRootDSE.Get("defaultNamingContext") 
    strBase = "<LDAP://" & strDNSDomain & ">" 
    
    ' Filter on user objects. 
    strFilter = "(&(objectCategory=person)(objectClass=user))" 
    
    ' Comma delimited list of attribute values to retrieve. 
    strAttributes = "sAMAccountName,givenName,sn,mail" 
    
    ' Construct the LDAP syntax query. 
    strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" 
    adoCommand.CommandText = strQuery 
    adoCommand.Properties("Page Size") = 100 
    adoCommand.Properties("Timeout") = 30 
    adoCommand.Properties("Cache Results") = False 
    
    ' Run the query. 
    Set adoRecordset = adoCommand.Execute 
 
    ' Enumerate the resulting recordset. 
    Do Until adoRecordset.EOF 
        ' Retrieve values and display. 
        strUserAccount = trim(UCase(adoRecordset.Fields("sAMAccountName").Value))
        strUserEntry   = trim(UCase(adoRecordset.Fields("givenName").Value & " " & adoRecordset.Fields("sn").Value))
        strUserMail    = trim(UCase(adoRecordset.Fields("mail").Value))
        if strUserAccount = "" then strUserAccount = null
        if strUserEntry   = "" then strUserEntry = null
        if strUserMail    = "" then strUserMail = null
        If IsNull(strUserAccount) OR IsNull(strUserEntry) OR IsNull(strUserMail) then
            'skip record, do nothing
        Else
            dicUserNameList.Add strUserEntry,strUserAccount
        End If
        adoRecordset.MoveNext
    loop
    txt_filterUserNames_onKeyUP
End Sub
 
Sub txt_filterUserNames_onKeyUP
    Set objList = document.getElementById( "lst_UserNames" )
    objList.ListItems.Clear
    if txt_filterUserNames.Value <> "" then
        for each User in dicUserNameList
            if InStr(UCase(User),UCase(txt_filterUserNames.Value)) then
                Set objListItem  = objList.ListItems.Add
                objListItem.Text = User
            end if
        next
    else
        for each User in dicUserNameList
            Set objListItem  = objList.ListItems.Add
            objListItem.Text = User
        next
    end if
End Sub
 
Private Sub lst_UserNames_DblClick()
    strUserEntry = lst_UserNames.SelectedItem.Text
    txt_filterUserNames.Value = strUserEntry
    txt_filterUserNames_onKeyUP
    msgbox strUserEntry
End Sub
 
</script>
<body>
Filter based on text keyed in filter box.  Double click the name you want to select.<br>
<OBJECT id="lst_UserNames" name="lst_UserNames" classid="clsid:BDD1F04B-858B-11D1-B16A-00C0F0283628"></OBJECT>
<br>Filter: <input type="text" size="40" id="txt_filterUserNames" name="txt_filterUserNames">
</body>
</html>

Open in new window

0
 
LVL 12

Author Comment

by:piattnd
ID: 24319149
An update on this:

The problem lies within my "sorting" function called SortDict (I got this code on the web, was just trying it out and can't figure it out).

Still need help on sorting the dictionary out!
0
 
LVL 12

Author Comment

by:piattnd
ID: 24319170
Got this message:


script-error.jpg
0
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
LVL 14

Expert Comment

by:rejoinder
ID: 24319771
If you don't have too many names in AD, you can add a line to the code above.
At line 97 add a line that says;
msgbox strUserEntry & "," & strUserAccount
When the HTA runs you will be looking for duplicate names - perhaps blank names?  Something to test out.
0
 
LVL 14

Expert Comment

by:rejoinder
ID: 24320095
Since you want to sort and filter arrays, try using disconnected record sets.  They offer similar features as a temporary database.  You can add fields, field types and field lengths.  Once you have built up your table, you will be able to sort and filter the record set for output.  See below for a sample.
Here is an example which uses a disconnected record set.
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23675665.html



Const adVarChar = 200
Const VarCharMaxCharacters = 255
Const adFldIsNullable = 32
 
 
 
Set UsersDB = CreateObject("ADOR.Recordset")
UsersDB.Fields.Append "CN", adVarChar, VarCharMaxCharacters, adFldIsNullable
UsersDB.Fields.Append "DistinguishedName", adVarChar, VarCharMaxCharacters, adFldIsNullable
UsersDB.Open
 
'code to loop through users in AD
    UsersDB.AddNew
    UsersDB("CN") = strCN
    UsersDB("DistinguishedName") = strDN
    UsersDB.Update
    '.movenext
'loop
 
if txt_MyFilter.Value = "" then
    UsersDB.Filter = ""
else
    UsersDB.Filter = "CN LIKE '*" & txt_MyFilter.Value & "*'"
end if
 
UsersDB.Sort = "CN"
 
If UsersDB.RecordCount > 0 then
    UsersDB.MoveFirst
    Do Until UsersDB.EOF
        strCN = UsersDB.Fields.Item("CN").Value
        strDN = UsersDB.Fields.Item("DistinguishedName").Value
        UsersDB.MoveNext
    Loop
End if

Open in new window

0
 
LVL 12

Author Comment

by:piattnd
ID: 24331556
Unfortunately I'll be dealing with upwards of 2,000ish accounts.  Joyful eh?  :)

Thanks much, I'll give this second one a shot when I can.  I was able to take the code i had in place, combined with your original idea, and was able to make a NON sorting solution.  Now, to just figure out why sorting isn't working properly.
0
 
LVL 14

Accepted Solution

by:
rejoinder earned 500 total points
ID: 24331713
Did you look at this example or sorting a dictionary object...
http://support.microsoft.com/default.aspx/kb/246067
0
 
LVL 12

Author Comment

by:piattnd
ID: 24505178
I was able to track down a friend who actually had a function that did the sort.  I have yet to impliment it (haven't had time), but I appreciate your help!
0
 
LVL 12

Author Closing Comment

by:piattnd
ID: 31578641
Thanks again for the help!
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

SASS allows you to treat your CSS code in a more OOP way. Let's have a look on how you can structure your code in order for it to be easily maintained and reused.
This article explains how to prepare an HTML email signature template file containing dynamic placeholders for users' Azure AD data. Furthermore, it explains how to use this file to remotely set up a department-wide email signature policy in Office …
In this tutorial viewers will learn how to style elements, such a divs, with a "drop shadow" effect using the CSS box-shadow property Start with a normal styled element, such as a div.: In the element's style, type the box shadow property: "box-shad…
Video by: Mark
This lesson goes over how to construct ordered and unordered lists and how to create hyperlinks.

840 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