Hi,
I am working with a database that someone else designed for my client. Originally these items used to function properly for my client. The original designer made a couple updates at some point, but I am not sure where in the timeline the problems started occuring. They have moved to Access 2010 since it was originally designed, and the tables may have had fields added since then as well. I am receiving "text you entered isn't an item in the list" errors for two similar subforms in the same form. They both use combo boxes that add new entries to the database.
Combobox -- "ComboStudentContactLink" and "ComboStudentContactLink2"
Limit to List: Yes
Allow Value List Edits: No
If you enter a name not in the table it triggers the "On Not in List" event called
"ComboStudentContactLink_NotInList"
This routine calls the AddFamily function which brings up a window with a more detailed form. Saving or closing throws errors. Clicking save throws an error, but it still saves it in the database. Sometimes you have to click "Save" twice before the error appears. Either way the record gets saved. I either get error "2237 The text you entered isn't an item in the list" or "3021': No current record" in a pop up window saying, "The text you entered isn't an item in the list. Select an item from the list, or enter text that matches of the listed items."
Debug takes it to "Me.comdAddContact.SetFocus"
from this section of code
Code:
Private Sub ComboStudentContactLink_NotInList(NewData As String, Response As Integer)
DoCmd.RunCommand acCmdUndo
' Call AddFamily(NewData, Me.ComboStudentContactLink, Me.cmdAddContact)
Call AddFamily(NewData)
Me.cmdAddContact.SetFocus
Me.ComboStudentContactLink.Visible = False
Response = 0
Me.Refresh
End Sub
Here are all the routines that come up from that same debugging window.
Code:
Option Compare Database
Option Explicit
Public gAddingStudent As Boolean
'Private Sub AddFamily(zName As String, zCombobox As ComboBox, zButton As CommandButton)
Private Sub AddFamily(zName As String)
Dim stDocName As String
Dim stLinkCriteria As String
Call UpdateQuickenID
Select Case TabCtlDetailInfor.Value
Case Is = gFamilyMode
stDocName = "frmFamilyInformation"
DoCmd.OpenForm stDocName, , , stLinkCriteria, , acDialog, zName
'Me.Recalc
'Sleep 1000
'Form.Refresh
Case Is = gPickupMode, gEmergencyMode
stDocName = "frmContactInformation"
DoCmd.OpenForm stDocName, acNormal, , stLinkCriteria, acAdd, acDialog, zName
'Me.Recalc
'Sleep 1000
'Form.Refresh
End Select
'zButton.SetFocus
'zCombobox.Visible = False
End Sub
Private Sub cmdAddContact_Click()
gContactAddMode = gEmergencyMode
Me.ComboStudentContactLink.Visible = True
Me.lblComboLinkContact.Visible = True
Me.ComboStudentContactLink.SetFocus
End Sub
Private Sub cmdAddContact2_Click()
gContactAddMode = gPickupMode
Me.ComboStudentContactLink2.Visible = True
Me.lblComboLinkContact2.Visible = True
Me.ComboStudentContactLink2.SetFocus
End Sub
Private Sub cmdLinkFamily_Click()
RunCommand acCmdSaveRecord
DoEvents
Me.ComboStudentFamilyLink_Label.Visible = True
Me.ComboStudentFamilyLink.Visible = True
Me.ComboStudentFamilyLink.SetFocus
End Sub
Private Sub comboID_AfterUpdate()
Dim rstStudent As Recordset
Dim xSelect As String
If Not (IsNull(Me!comboID.Value)) Then
Set rstStudent = Me.RecordsetClone
xSelect = "[ID] = " & Me!comboID.Value
rstStudent.FindFirst xSelect
If rstStudent.NoMatch Then
MsgBox "No match found!"
Else
Me.Detail.Visible = True
gAddingStudent = False
Me.Bookmark = rstStudent.Bookmark
End If
Else
If gAddingStudent = False Then
Me.Detail.Visible = False
End If
End If
'rstStudent.Close
Set rstStudent = Nothing
End Sub
Private Sub comboID_NotInList(NewData As String, Response As Integer)
Dim xResponse As Long
Dim xMessage As String
DoCmd.RunCommand acCmdUndo
Me.comboID.Value = Null
xMessage = "Add new student: " & NewData & "?"
xResponse = MsgBox(xMessage, vbYesNo, "Click Yes to add new student")
If xResponse = vbYes Then
Call Enter_New_Student_Click
End If
Response = 0
End Sub
Private Sub ComboStudentContactLink_NotInList(NewData As String, Response As Integer)
DoCmd.RunCommand acCmdUndo
' Call AddFamily(NewData, Me.ComboStudentContactLink, Me.cmdAddContact)
Call AddFamily(NewData)
Me.cmdAddContact.SetFocus
Me.ComboStudentContactLink.Visible = False
Response = 0
Me.Refresh
End Sub
Private Sub ComboStudentContactLink2_LostFocus()
Call LinkContact(ComboStudentContactLink2.Value)
Me.cmdAddContact2.SetFocus
Me.ComboStudentContactLink2.Visible = False
Me.lblComboLinkContact2.Visible = False
End Sub
Private Sub ComboStudentContactLink2_NotInList(NewData As String, Response As Integer)
DoCmd.RunCommand acCmdUndo
' Call AddFamily(NewData, Me.ComboStudentContactLink2, Me.cmdAddContact2)
Call AddFamily(NewData)
Me.cmdAddContact2.SetFocus
Me.ComboStudentContactLink2.Visible = False
Response = 0
Me.Refresh
End Sub
Private Sub ComboStudentFamilyLink_NotInList(NewData As String, Response As Integer)
' DoCmd.RunCommand acCmdUndo
' Call AddFamily(NewData, Me.ComboStudentFamilyLink, Me.cmdLinkFamily)
ComboStudentFamilyLink.Text = ""
Call AddFamily(NewData)
Me.cmdLinkFamily.SetFocus
Me.ComboStudentFamilyLink.Visible = False
Response = 0
Me.Refresh
End Sub
Private Sub ComboStudentFamilyLink_LostFocus()
Dim xStudentID As String
Dim dbsMRS As Database
Dim rstStudentFamilyLink As Recordset
Dim Response
If ComboStudentFamilyLink.Value > 0 Then
Set dbsMRS = CurrentDb
Set rstStudentFamilyLink = dbsMRS.OpenRecordset("StudentFamilyLink", dbOpenDynaset)
Me!txtStudentID.SetFocus
xStudentID = txtStudentID.Value
DoEvents
Response = MsgBox("Is this the Custodial Family?", vbYesNo, "New Family Link")
With rstStudentFamilyLink
.AddNew
!ID = xStudentID
!Family = ComboStudentFamilyLink.Value
If Response = vbYes Then
!Custodial = True
Else
!Custodial = False
End If
.Update
.Bookmark = .LastModified
End With
rstStudentFamilyLink.Close
dbsMRS.Close
Me!ComboStudentFamilyLink.SetFocus
Me!ComboStudentFamilyLink.Value = Null
Me!cmdLinkFamily.SetFocus
Me!ChildFamilyInformation.SetFocus
Me!ComboStudentFamilyLink.Visible = False
DoEvents
'Me.Recalc
Form.Refresh
' Else
' Sleep 1000
' Me!ChildFamilyInformation.SetFocus
' Me.ComboStudentFamilyLink_Label.Visible = False
' Me!ComboStudentFamilyLink.Visible = False
End If
End Sub
Private Sub ComboStudentContactLink_LostFocus()
Call LinkContact(ComboStudentContactLink.Value)
Me.cmdAddContact.SetFocus
Me.ComboStudentContactLink.Visible = False
Me.lblComboLinkContact.Visible = False
End Sub
Private Sub LinkContact(zLinkValue)
Dim xStudentID As String
Dim dbsMRS As Database
Dim rstStudentContactLink As Recordset
If zLinkValue > 0 Then
Set dbsMRS = CurrentDb
If TabCtlDetailInfor.Value = gEmergencyMode Then
Set rstStudentContactLink = dbsMRS.OpenRecordset("StudentContactLink", dbOpenDynaset)
Else
Set rstStudentContactLink = dbsMRS.OpenRecordset("StudentPickupLink", dbOpenDynaset)
End If
Me!txtStudentID.SetFocus
xStudentID = txtStudentID.Value
'wrkDefault.BeginTrans
With rstStudentContactLink
.AddNew
!StudentID = xStudentID
!ContactID = zLinkValue
.Update
.Bookmark = .LastModified
End With
'wrkDefault.CommitTrans dbForceOSFlush
rstStudentContactLink.Close
dbsMRS.Close
'Me!ComboStudentContactLink.SetFocus
'Me!ComboStudentContactLink.Value = Null
'Me!cmdLinkFamily.SetFocus
'Me!ComboStudentContactLink.Visible = False
'If TabCtlDetailInfor.Value = gEmergencyMode Then
' Me!ChildContactInformation.SetFocus
'Else
' Me!SubFormPickUpAuthorization.SetFocus
'End If
DoEvents
'Me.Recalc
'Form.Refresh
Else
'If TabCtlDetailInfor.Value = gEmergencyMode Then
' Me!ChildContactInformation.SetFocus
'Else
' Me!SubFormPickUpAuthorization.SetFocus
'End If
'Me!ComboStudentContactLink.Visible = False
End If
End Sub
Private Sub Enter_New_Student_Click()
On Error GoTo Err_Enter_New_Student_Click
Me.comboID.Value = Null
Me.comboID.SetFocus
Me.comboID.Text = ""
Me.Detail.Visible = True
gAddingStudent = True
DoCmd.GoToRecord , , acNewRec
DoEvents
Me![txtLastName].SetFocus
Exit_Enter_New_Student_Click:
Exit Sub
Err_Enter_New_Student_Click:
MsgBox Err.Description
Resume Exit_Enter_New_Student_Click
End Sub
Private Sub Form_Current()
Me!pgClassrooms.MainInputForm!Monday.ColumnWidth = -2
End Sub
Private Sub Form_Load()
Me.comboID.SetFocus
Me.Detail.Visible = False
End Sub
Private Sub Frame1610_Enter()
Call comboID_LostFocus
End Sub
Private Sub Initial_LostFocus()
Call UpdateQuickenID
End Sub
Private Sub UpdateQuickenID()
If IsNull(Me!QuickenID.Value) Then
Me!QuickenID.Value = Me!txtLastName.Value & ", " & Me![First Name].Value
If Not IsNull(Me.Initial) Then
Me!QuickenID.Value = Me!QuickenID.Value & " " & Me.Initial
End If
End If
End Sub
Private Sub comboID_KeyPress(KeyAscii As Integer)
If KeyAscii = 9 Or KeyAscii = 13 Then
'Call comboID_LostFocus
End If
End Sub
Private Sub comboID_Click()
'comboID_LostFocus
End Sub
Private Sub comboID_LostFocus()
Dim rstStudent As Recordset
Dim xSelect As String
If Not (IsNull(Me!comboID.Value)) Then
'xSelect = "SELECT Students.* FROM Students WHERE ID = " & Me.comboID.Value & ";"
'Me.RecordSource = xSelect
xSelect = "[ID] = " & Me!comboID.Value
Set rstStudent = Me.RecordsetClone
rstStudent.FindFirst xSelect
Me.Detail.Visible = True
gAddingStudent = False
'Me.Recalc
'Form.Refresh
Else
If gAddingStudent = False Then
Me.Detail.Visible = False
End If
End If
'Set rstStudent = Me.RecordsetClone
'xSearch = "[ID] = " & Me!comboID.Value
'rstStudent.FindFirst xSearch
'Me.Bookmark = rstStudent.Bookmark
End Sub
Private Sub pageFamilyInfo_Click()
'Call comboID_LostFocus
End Sub
Private Sub txtLastName_KeyPress(KeyAscii As Integer)
Me.comboID.Value = Me.ID.Value
End Sub
Private Sub cmdDeleteStudent_Click()
On Error GoTo Err_cmdDeleteStudent_Click
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
Exit_cmdDeleteStudent_Click:
Exit Sub
Err_cmdDeleteStudent_Click:
MsgBox Err.Description
Resume Exit_cmdDeleteStudent_Click
End Sub
Thanks!