asked on

Dynamic listbox not working properly

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

rejoinder

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

piattnd

ASKER

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!

piattnd

ASKER

Got this message:

script-error.jpg

rejoinder

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.

rejoinder

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.
https://www.experts-exchange.com/questions/23675665/How-can-I-sort-a-dynamic-multi-dimentional-array.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

piattnd

ASKER

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.

ASKER CERTIFIED SOLUTION

rejoinder

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

piattnd

ASKER

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!

piattnd

ASKER

Thanks again for the help!