
ListView Control - Removing selected items from the list
Hello fellow Access people!
I'm using a listview control in place of a listbox (because of its greater
flexibility) to allow a user to add certain records to another listbox (and
table).
I can fill the control fine. I can access the selected items fine. My
problem is removing the items which have been selected. I've tried many
ways of doing it but have not so far succeeded.
Does anyone have any handy code to post or email? Or any suggestions for
how to provide a sortable list with sizeable headers to act as a glorified
multi-select listbox?
Thanks for reading this far.
Carl White
there to fool spambots)
Here is an example of what I've been doing. The code works fine, adding the
selected records to a table and a corresponding listbox on another form.
However, only the first selected item in the ListView control is removed. I
suspect because once I remove an item, the indices are recalculated, but
that's a guess.
**** to fill the control *****
Sub PopulateATXControl()
Dim db As Database
Dim rs As Recordset
Dim ATXList As Control
Dim lstItem As ListItem
Dim strMsgBoxTitle As String
Dim qdf As QueryDef
Set db = CurrentDb()
Set qdf = db.QueryDefs("qryListNonMembersListViewSubQuery")
qdf.SQL = "SELECT tblListMembers.ContactID, tblListMembers.ListID " & _
"FROM tblListMembers, tblCompany " & _
"WHERE (((tblListMembers.ListID)=" &
Forms!frmMaintainListMembership!ListsLB & "));"
Set rs = db.OpenRecordset("qryListNonMembersListViewQuery")
strMsgBoxTitle = "Add Contact(s) to List"
If rs.BOF Then
MsgBox "There are no contacts in the database who are not members of
this list!", vbOKOnly, strMsgBoxTitle
rs.Close
Exit Sub
End If
' display the number of items in the list
Me!ListCountLabel.Caption = "There are " & str$(DCount("*",
"qryListNonMembersListViewQuery")) & " items on the list."
Set ATXList = Me![ATXContactList]
ATXContactList.View = lvwReport
rs.MoveFirst
While Not rs.EOF
Set lstItem = ATXContactList.ListItems.Add()
If Not IsNull(rs![Contact Name]) Then
lstItem.Text = rs![Contact Name]
lstItem.SubItems(1) = IIf(IsNull(rs![Position]), "",
rs![Position])
lstItem.SubItems(2) = IIf(IsNull(rs![Company]), "",
rs![Company])
lstItem.SubItems(3) = IIf(IsNull(rs![Site]), "", rs![Site])
lstItem.SubItems(4) = IIf(IsNull(rs![ContactID]), "",
rs![ContactID])
End If
rs.MoveNext
Wend
rs.Close
End Sub
**** this is where the trouble is...
Private Sub AddNowCB_Click()
' Add new rows to tblListMembers
Dim intIndex As Integer
Dim db As Database
Dim rs As Recordset
Dim ctlATXList As Control
Dim itmListItem As ListItem
On Error GoTo Err_AddNow_Click
DoCmd.Hourglass True
Set db = CurrentDb() '
point to database
Set rs = db.OpenRecordset("tblListMembers") '
point to relationships table
Set ctlATXList = Me!ATXContactList
' point to Ac
For intIndex = 1 To ctlATXList.ListItems.Count ' for all of
the rows in the listbox
Set itmListItem = ctlATXList.ListItems.Item(intIndex)
If itmListItem.Selected = True Then
With rs
.AddNew
' add a new record
!ContactID = itmListItem.SubItems(4)
' set relationship
!ListID = Forms![frmMaintainListMembership]![ListsLB]
' set contact id
.Update
' commit the change
End With
End If
Next intIndex '
loop through all rows of listbox
' *******
' *******
' *******
' *******
' ******* now remove selected items from list
For Each itmListItem In ctlATXList.ListItems '
for all of the rows in the listbox
Debug.Print itmListItem.Index
If itmListItem.Selected = True Then
ctlATXList.ListItems.Remove itmListItem.Index
ctlATXList.Requery
End If
Next itmListItem '
loop through all rows of listbox
' update label showing record count
Me!ListCountLabel.Caption = "There are " & str$(DCount("*",
"qryListNonMembersListViewQuery")) & " items on the list."
rs.Close '
close recordset
db.Close '
close database
' now refresh the list in the list membership form
Forms![frmMaintainListMembership]![ListMembersLB].Requery
Forms![frmMaintainListMembership]![ListMemberCountLabel].Caption = "This
list contains " & _
DCount("*", "qryGetListMembershipForSelectedList") & _
" members."
DoCmd.Hourglass False
Exit_AddNow_Click:
Exit Sub
Err_AddNow_Click:
If Err = 35606 Then
Resume Next
Else
MsgBox "Error #" & Err & " - " & Err.Description
Resume Exit_AddNow_Click
End If
End Sub