?
Solved

Dynamic listbox not working properly

Posted on 2009-05-06
9
Medium Priority
?
746 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
[X]
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
  • 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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
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 2000 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

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

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

Find out what you should include to make the best professional email signature for your organization.
Finding original email is quite difficult due to their duplicates. From this article, you will come to know why multiple duplicates of same emails appear and how to delete duplicate emails from Outlook securely and instantly while vital emails remai…
In this tutorial viewers will learn how to style transparent/translucent elements using alpha transparency in CSS Start with a normal styled element, such as a div.: Define its "background-color" property as "rgba (255, 255, 255, .5): The numbers in…
The viewer will learn the basics of jQuery including how to code hide show and toggles. Reference your jQuery libraries: (CODE) Include your new external js/jQuery file: (CODE) Write your first lines of code to setup your site for jQuery…

649 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