Problem witn the code

[Matizo]

Hello,
I'm trying to create an attendance database. I have used some examples that I have found out on this forum. I'm beginner so there may be few errors.
As an sample database I have used a CAUGMembership database created by Patricia Hartman. Currently I have:
2 tables:
tblAttendance
tblStudents

Queries:
qAttendance
qStudentsLst

Forms:
frmAttendance
frmStudentsLst

In the frmAttendance I have created a list box with the list of students. Next the text box (attendance date) showing the current date and called this field txtToday

Than I have created another text box and called it txtNotice

Now I have created the command button and named it cmdAddAtt with caption: Add New Attendance Record.

I have coppied the original code from the sample database and tried to change it but when I am trying to process that attendance there is an error. I’m not sure what I have replace wrong or not replace. The original code:

Option Compare Database
Option Explicit

Private Sub cmdCreate_Click()
On Error GoTo Err_cmdCreate_Click

Me.txtNotice = CreateAttendanceRecords(Me.lstMembers)
Me.lstMembers.Requery

Exit_cmdCreate_Click:
Exit Sub

Err_cmdCreate_Click:
MsgBox Err.Number & "-" & Err.Description
Resume Exit_cmdCreate_Click

End Sub

Public Function CreateAttendanceRecords(ctlRef As ListBox) As String
On Error GoTo Err_CreateAttendanceRecords_Click

Dim i As Variant
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qd As DAO.QueryDef

Set dbs = CurrentDb
Set qd = dbs.QueryDefs!qAttendance
Set rst = qd.OpenRecordset

For Each i In ctlRef.ItemsSelected
rst.AddNew
rst!MailingListID = ctlRef.ItemData(i)
rst!AttendanceDate = Me.txtToday
rst.Update
Next i
Set rst = Nothing
Set qd = Nothing
CreateAttendanceRecords = "Records Created"

Exit_CreateAttendanceRecords_Click:
Exit Function

Err_CreateAttendanceRecords_Click:
Select Case Err.Number
Case 3022 'ignore duplicate keys
Resume Next
Case Else
MsgBox Err.Number & "-" & Err.Description
Resume Exit_CreateAttendanceRecords_Click
End Select

End Function



Private Sub Form_Resize()
'Const LeftRightPadding = (0.125 + 0.25) * 1440
Const TopBottomPadding = (0.25 + 0.375) * 1440

Me.lstMembers.Height = Me.InsideHeight - TopBottomPadding
'Me.lstMembers.Width = Me.InsideWidth - LeftRightPadding
End Sub


And after I changed few things:

Option Compare Database
Option Explicit

Private Sub cmdAddAtt_Click()
On Error GoTo Err_cmdAddAtt_Click

Me.txtNotice = AddNewAttendanceRecord(Me.lstStudents)
Me.lstStudents.Requery

Exit_cmdAddAtt_Click:
Exit Sub

Err_cmdAddAtt_Click:
MsgBox Err.Number & "-" & Err.Description
Resume Exit_cmdAddAtt_Click

End Sub

Public Function AddNewAttendanceRecord(ctlRef As ListBox) As String
On Error GoTo Err_AddNewAttendanceRecord_Click

Dim i As Variant
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qd As DAO.QueryDef

Set dbs = CurrentDb
Set qd = dbs.QueryDefs!qAttendance
Set rst = qd.OpenRecordset

For Each i In ctlRef.ItemsSelected
rst.AddNew
rst!StudentID = ctlRef.ItemData(i)
rst!AttendanceDate = Me.txtToday
rst.Update
Next i
Set rst = Nothing
Set qd = Nothing
AddNewAttendanceRecord = "Records Created"

Exit_AddNewAttendanceRecord_Click:
Exit Function

Err_AddNewAttendanceRecord_Click:
Select Case Err.Number
Case 3022 'ignore duplicate keys
Resume Next
Case Else
MsgBox Err.Number & "-" & Err.Description
Resume Exit_ AddNewAttendanceRecord _Click
End Select

End Function



Private Sub Form_Resize()
'Const LeftRightPadding = (0.125 + 0.25) * 1440
Const TopBottomPadding = (0.25 + 0.375) * 1440

Me.lstStudents.Height = Me.InsideHeight - TopBottomPadding
'Me.lstStudents.Width = Me.InsideWidth - LeftRightPadding
End Sub



I have attached my database so if someone could check it and tell my what I'm doning wrong.

Many thaks,

 

[jc1104]

Hi,

Had a look at your project and changed a couple of things.

First, changed the control name of the list box on the form frmAttendance to lstStudents.

Second, changed part of the code in the function AddNewAttendancerecord to:

For Each i In ctlRef.ItemsSelected
rst.AddNew
rst!StudentId = ctlRef.ItemsSelected.Item(i - 1)
'rst!StudentId = ctlRef.ItemData(i)
rst!AttendanceDate = Me.txtToday
rst.Update
Next i
Set rst = Nothing
Set qd = Nothing
AddNewAttendancerecord = "Records Created"



Seemed to work fine after that.
This change uses the StudentId (not the name as a data type of 'Text' and 'Number' are not compatible) to put the record into the tblAttendance.

Use relationships to tie the StudentId back to the StudentName in tblStudents.

Hope this helps.

JC