Yep, I was moving the rs.close around to see if that would help, to no avail.
Now I should say, that I am learning all this by the seat of my pants, so I
don't know if I am doing all of it in the most efficient manner. Anyhow, the
whole sub you say? Here it is, and I have added comments at the beginning of
each step, and if you scroll down, you will see the <<<<<===== I put in from
the last post. I have a couple of Excel macros where I use the Call function,
and I am wondering aloud now if that function also works in Access. I'm
thinking I should maybe turn this into a couple of subs, and only call them
as I need them. Is that possible? Anyhow, here it is. Thank you for your
reply.
Private Sub cmdAdd_Click()
On Error GoTo Err_cmdAdd_Click
Dim cn As ADODB.Connection
'Student variables
Dim rsStudentCheck As ADODB.Recordset
Dim rsSTUDENT_ID As ADODB.Recordset
Dim strsqlStudentCheck As String
Dim strSQLInsertStudent As String
Dim strSQLSTUDENT_ID As String
'Parent variables
Dim rsParentCheck As ADODB.Recordset
Dim rsPARENT_ID As ADODB.Recordset
Dim strSQLParentCheck As String
Dim strSQLInsertParent As String
Dim strSQLPARENT_ID As String
Dim strSQLUpdatePARENT_ID As String
'Update variables
'Dim STU_ID As Integer
'Dim PAR_ID As Integer
'Dim strSQLUpdatePARENT_ID
Dim booldupid As Boolean
'*************************************************************************
' SQL strings for student actions
strsqlStudentCheck = "SELECT stu_name_first,stu_name_last,
stu_birthday " & _
"FROM STUDENTS " & _
"WHERE stu_name_first = '" & Me.txtFirstName.Value & "' " & _
"AND stu_name_last = '" & Me.txtLastName.Value & "' " & _
"AND stu_birthday = " & "#" & Me.txtDOB.Value & "#" & ";"
strSQLInsertStudent = "INSERT INTO STUDENTS (stu_name_first,
stu_name_last,stu_birthday) " & _
"SELECT '" & Me.txtFirstName.Value & "','" & Me.txtLastName.
Value & "','" & Me.txtDOB.Value & "' "
strSQLSTUDENT_ID = "SELECT STUDENT_ID AS newSTUDENT_ID " & _
"FROM STUDENTS s " & _
"WHERE s.stu_name_first = '" & Me.txtFirstName.Value & "' " & _
"AND s.stu_name_last = '" & Me.txtLastName.Value & "' " & _
"AND s.stu_birthday = " & "#" & Me.txtDOB.Value & "#" & ";"
'*************************************************************************
' SQL strings for parent actions
strSQLParentCheck = "SELECT DISTINCT par_name_last AS ParentIDCheck "
& _
"FROM PARENTS " & _
"WHERE par_name_last = '" & Me.txtLastName.Value
& "'; "
strSQLInsertParent = "INSERT INTO PARENTS(par_name_last,par_mother,
par_father) " & _
"SELECT '" & Me.txtLastName.Value & "','" & Me.
txtMother.Value & "','" & Me.txtFather.Value & "';"
strSQLPARENT_ID = "SELECT PARENT_ID AS PARENT_ID " & _
"FROM PARENTS " & _
"WHERE par_name_last = '" & Me.txtLastName.Value &
"' " & _
"AND par_mother = '" & Me.txtMother.Value & "' " &
_
"AND par_father = '" & Me.txtFather.Value & "';"
'***************************************************************************
' Student Actions
'***************************************************************************
' check to see if student exists before inserting.
' If he/she exists, no record will be inserted. If not,
' he/she will be inserted
booldupid = False
Set rsStudentCheck = New ADODB.Recordset
Set cn = Application.CurrentProject.Connection
rsStudentCheck.Open strsqlStudentCheck, cn, adOpenForwardOnly,
adLockOptimistic
' Check for existing student
If rsStudentCheck.EOF Then
booldupid = False
rsStudentCheck.Close
Cancel = booldupid
' Insert new students
DoCmd.SetWarnings False
'MsgBox ("inserting student now")
DoCmd.RunSQL strSQLInsertStudent
DoCmd.SetWarnings True
' For newly inserted students, return the STUDENT_ID
Set rsSTUDENT_ID = New ADODB.Recordset
Set cn = Application.CurrentProject.Connection
rsSTUDENT_ID.Open strSQLSTUDENT_ID, cn, adOpenForwardOnly,
adLockOptimistic
' Update STUDENT_ID field on the student add form
Me.txtStudent_ID = (rsSTUDENT_ID("newSTUDENT_ID"))
Me.txtStudent_ID.Requery
rsSTUDENT_ID.Close
' If student already exists, return the STUDENT_ID
Else
If Not rsStudentCheck.EOF Then
booldupid = True
If MsgBox("Student already exists in Students table, do you
want to view the record?", vbYesNo) = vbYes Then
' Retrieve STUDENT_ID
Set rsSTUDENT_ID = New ADODB.Recordset
Set cn = Application.CurrentProject.Connection
rsSTUDENT_ID.Open strSQLSTUDENT_ID, cn, adOpenForwardOnly,
adLockOptimistic
' Update STUDENT_ID field on student add form
Me.txtStudent_ID = (rsSTUDENT_ID("newSTUDENT_ID"))
Me.txtStudent_ID.Requery
rsSTUDENT_ID.Close
' Set Students_Main filter based on STUDENT_ID field on
student add form
With Forms!frmStudents_Main
.Form!frmStudents_Child.Visible = True
!txtStudent_ID = Me.txtStudent_ID.Value
End With
Forms!frmStudents_Main!frmStudents_Child.Form.Filter =
"student_id = " & Forms!frmStudents_Main.txtStudent_ID.Value & " "
Forms!frmStudents_Main!frmStudents_Child.Form.FilterOn = True
DoCmd.Close '<<<<=== I need the rest of the sub to stop
running after this
End If
End If
End If
'MsgBox ("student action complete")
'**************************************************************************
' Parent Actions
'**************************************************************************
' Use the same method to check for existing parents. They should
already
' be in the database for younger siblings of previous students.
' Check to see if the last name exists in PARENTS
booldupid = False
Set rsParentCheck = New ADODB.Recordset
Set cn = Application.CurrentProject.Connection
rsParentCheck.Open strSQLParentCheck, cn, adOpenForwardOnly,
adLockOptimistic
' If the last name does not exist, add the record now
If rsParentCheck.EOF Then
booldupid = False
rsParentCheck.Close
Cancel = booldupid
DoCmd.SetWarnings False
MsgBox ("inserting parent record")
DoCmd.RunSQL strSQLInsertParent
DoCmd.SetWarnings True
' Open the connection to get the PARENT_ID
Set rsPARENT_ID = New ADODB.Recordset
Set cn = Application.CurrentProject.Connection
rsPARENT_ID.Open strSQLPARENT_ID, cn, adOpenForwardOnly,
adLockOptimistic
' Set parent_id value on student add form
Me.txtPARENT_ID.Value = (rsPARENT_ID("parent_id"))
' Update new student record with new parent_id
strSQLUpdateParentID = "UPDATE STUDENTS " & _
"SET Parent_id = " & Me.txtPARENT_ID.Value & "
" & _
"WHERE student_id = " & Me.txtStudent_ID.Value
& " "
DoCmd.SetWarnings False
MsgBox ("Synching PARENT_ID now")
DoCmd.RunSQL strSQLUpdateParentID
DoCmd.SetWarnings True
If MsgBox("Parent record inserted, do you want to view the student
record now?", vbYesNo) = vbYes Then
With Forms!frmStudents_Main
.Form!frmStudents_Child.Visible = True
!txtStudent_ID = Me.txtStudent_ID.Value
End With
Forms!frmStudents_Main!frmStudents_Child.Form.Filter =
"student_id = " & Forms!frmStudents_Main.txtStudent_ID.Value & " "
Forms!frmStudents_Main!frmStudents_Child.Form.FilterOn = True
'DoCmd.Close
End If
Else
If Not rsParentCheck.EOF Then
booldupid = True
If MsgBox("A similar parent record exists in Parents table, do
you want to check for a match?", vbYesNo) = vbYes Then
Dim strSQLParents As String
Dim strSQLCleanSlate As String
strSQLCleanSlate = "DELETE FROM ZZ_PARENTS"
DoCmd.RunSQL strSQLCleanSlate
strSQLParents = "INSERT INTO ZZ_PARENTS (parent_id,
name_concat) " & _
"SELECT DISTINCT parent_id, name_concat " &
_
"FROM qry_Search_Parents " & _
"WHERE par_name_last = '" & Me.txtLastName.
Value & "'; "
DoCmd.RunSQL strSQLParents
Me.cmdAddParents.Visible = True
Me.Child20.SourceObject = "frmSearch_Parents"
Me.Child20.Form.Requery
Me.cmdAddParents.Visible = True
End If
End If
End If
Exit_cmdAdd_Click:
Exit Sub
Err_cmdAdd_Click:
MsgBox Err.Description
Resume Exit_cmdAdd_Click:
End Sub
Without seeing the entire Sub, can't tell, but what I do notice is that is
what is posted, you close the form without first having closed the recordset
and without setting the recordset object to nothing.
Greetings folks. I have a long sub on a student add form that addes new
students to a students table. There are various points at which the user is
[quoted text clipped - 33 lines]
running after this
End If
