Using the Control Key on a Listbox

C

Cameron

I have a form that the users use to define attendees for tabulation of
courses. On the one side is a filtered listbox that lists all the employees,
and on the other side of the form is a listbox that gets filled when a button
is pressed. The user is to select the employees that will be attending from
the first listbox and then press the input button to transfer those employee
names to the second listbox. I have had a request by one user to be able to
block transfer employees by using the control keys. I have noticed that
holding down the control key results in being able to block select employees
in the listbox, but when the transfer button is pressed only the last clicked
on employee gets transfered. How might I assure that all those employees in
the block selected get moved?

the code for the transfer button is as follows:

Private 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")

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 - 1
'MsgBox "on item # " & I
If Me!EmployeesList.Selected(I) = True 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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top