Listbox messing up

[Cameron]

I have a listbox set to multi-select and in the past is has worked to use the
control key to select items in the listbox and then move them over to records
in a table. But at some point in time this all stopped working. Now the user
can select a number of items in the listbox but when they press the button to
move them, they only get the last item selected.

The code for the button is as follows:

Public Sub MoveToAttendees_Click()
On Error GoTo MoveToAttendeesError

Dim MyDB As Database
Dim MyStudents As Recordset
Dim MyEmployees As Recordset
Dim vExpiryDate As String
Dim I, X As Integer

Set MyDB = CurrentDb
Set MyStudents = MyDB.OpenRecordset("SessionAttendance", dbOpenDynaset)

DoCmd.Hourglass True

If [Forms]![CoursesMain]![RecertPeriod] <> 99 Then
vExpiryDate = DateAdd("d", (365 *
[Forms]![CoursesMain]![RecertPeriod]), Me.Date)
Else
vExpiryDate = "01-Jan-2999"
End If

For I = 0 To Me.EmployeesList.ListCount
Debug.Print Me!EmployeesList.Selected(I)
If Me!EmployeesList.Selected(I) Then
With MyStudents
.AddNew
!CourseID = Me.CourseID
!SessionID = Me.SessionID
!EmpID = Me.EmployeesList.ItemData(I)
!Attended = True
.Update
AttendAdd Forms!CoursesMain!TrainingType,
Me.CourseID, Me.SessionID, Me.EmployeesList.ItemData(I), Me.Date, vExpiryDate
End With
End If
Next I

MyStudents.Close
MyDB.Close
Set MyDB = Nothing
Form.Refresh
DoCmd.Hourglass False
Me.MoveToAttendees.DefaultValue = False
Exit Sub

MoveToAttendeesError:
If err.Number = 3022 Then 'Duplicate record
MsgBox "The employee '" & Me!EmployeesList.Column(2, I) & " " &
Me!EmployeesList.Column(1, I) & _
"' is already attending this session."
End If

If err.Number = 3140 Then Resume Next
'Else
'MsgBox Error$ & err.Number
'End If
Form.Refresh
MyStudents.Close
MyDB.Close
Set MyDB = Nothing
DoCmd.Hourglass False
Me.MoveToAttendees.DefaultValue = False
End Sub

What could be wrong with this code?

 

[George Nicholson]

1) The code you provided doesn't add items to a listbox. You need to show us
AttendAdd. My guess is the "only last item gets added" problem is there.

2) For I = 0 To Me.EmployeesList.ListCount -1

HTH,

 

[Cameron]

Actually, this code adds items to the Sessions table and then refreshes the
form, the other listbox has a query to display the items that are associated
with the ID for this session. So when the refresh runs the other listbox
updates with the records that have been just added by the first listbox.

The odd thing is this code worked up until about a year ago and now will not
allow multiple selection of items to be transfered to the table. But only
proceses the last selected item. And hence why I am kind of baffled.

1) The code you provided doesn't add items to a listbox. You need to show us
AttendAdd. My guess is the "only last item gets added" problem is there.

2) For I = 0 To Me.EmployeesList.ListCount -1

HTH,

I have a listbox set to multi-select and in the past is has worked to use
the
control key to select items in the listbox and then move them over to
records
in a table. But at some point in time this all stopped working. Now the
user
can select a number of items in the listbox but when they press the button
to
move them, they only get the last item selected.

The code for the button is as follows:

Public Sub MoveToAttendees_Click()
On Error GoTo MoveToAttendeesError

Dim MyDB As Database
Dim MyStudents As Recordset
Dim MyEmployees As Recordset
Dim vExpiryDate As String
Dim I, X As Integer

Set MyDB = CurrentDb
Set MyStudents = MyDB.OpenRecordset("SessionAttendance", dbOpenDynaset)

DoCmd.Hourglass True

If [Forms]![CoursesMain]![RecertPeriod] <> 99 Then
vExpiryDate = DateAdd("d", (365 *
[Forms]![CoursesMain]![RecertPeriod]), Me.Date)
Else
vExpiryDate = "01-Jan-2999"
End If

For I = 0 To Me.EmployeesList.ListCount
Debug.Print Me!EmployeesList.Selected(I)
If Me!EmployeesList.Selected(I) Then
With MyStudents
.AddNew
!CourseID = Me.CourseID
!SessionID = Me.SessionID
!EmpID = Me.EmployeesList.ItemData(I)
!Attended = True
.Update
AttendAdd Forms!CoursesMain!TrainingType,
Me.CourseID, Me.SessionID, Me.EmployeesList.ItemData(I), Me.Date,
vExpiryDate
End With
End If
Next I

MyStudents.Close
MyDB.Close
Set MyDB = Nothing
Form.Refresh
DoCmd.Hourglass False
Me.MoveToAttendees.DefaultValue = False
Exit Sub

MoveToAttendeesError:
If err.Number = 3022 Then 'Duplicate record
MsgBox "The employee '" & Me!EmployeesList.Column(2, I) & " " &
Me!EmployeesList.Column(1, I) & _
"' is already attending this session."
End If

If err.Number = 3140 Then Resume Next
'Else
'MsgBox Error$ & err.Number
'End If
Form.Refresh
MyStudents.Close
MyDB.Close
Set MyDB = Nothing
DoCmd.Hourglass False
Me.MoveToAttendees.DefaultValue = False
End Sub

What could be wrong with this code?