NotInList Message Box

Question

В моей базе данных есть три связанных таблицы; tblG5Property, tblG3ZIP, tblG2City. tblG5Property имеет fk, связанный с pk в tblG3ZIP, который имеет fk, связанный с pk в tblG2City.

У меня есть две формы, связанные с этими таблицами, frmProperty & frmCity. Когда пользователь добавляет новый адрес и ему необходимо добавить новый ZIP-код, у меня есть следующий код в NotInList даже для комбобокса ctrlg5ZIP в frmProperty.

Private Sub ctrlg5ZIP_NotInList(NewData As String, Response As Integer) 
On Error GoTo ctrlg5ZIP_NotInList_Err 

'Variable Declarations 
Dim vntResult 
Dim dbsCurrent As Database 
Dim rstZIPs As Recordset 

' Exit this subroutine if the combo box was cleared. 
If NewData = "" Then Exit Sub 

If MsgBox("The City/ZIP " & NewData & " is not currently listed." _ 
    & vbCrLf & "Would you like to add it to the list now?", vbQuestion + vbOKCancel, _ 
    "Homeland Real Estate") = vbOK Then 

    Response = acDataErrAdded 
    DoCmd.OpenForm "frmCity", , , , acFormAdd, acNormal 

Else 
    'Return User to form 
    Response = acDataErrContinue 
    MsgBox "Please try again!", , "Homeland Real Estate" 
    Me!ctrlg2City.SetFocus 
    Exit Sub 
End If 

'Error Handling 
ctrlg5ZIP_NotInList_Exit: 
    Exit Sub 

ctrlg5ZIP_NotInList_Err: 
    MsgBox Err.Description, vbCritical, "Error" 
    Resume ctrlg5ZIP_NotInList_Exit 

End Sub 

Проблема заключается в том, что сообщение об ошибке «Текст, который вы ввели, а не элемент в списке» появляется немедленно. Я добавил следующий код в мое событие frmCity AfterUpdate, но ошибка появляется, как только открывается frmCity, а не после ее закрытия.

On Error GoTo Err_Handler 
'From http://allenbrowne.com/ser-27.html#NotInList 
'Purpose: Requery the combo that may have called this in its DblClick 
Dim cbo As ComboBox 
Dim iErrCount As Integer 
Const strcCallingForm = "frmProperty" 

If CurrentProject.AllForms(strcCallingForm).IsLoaded Then 
    Set cbo = Forms(strcCallingForm)!ctrlg5ZIP 
    cbo.Requery 
End If 

Exit_Handler: 
    Exit Sub 

Err_Handler: 
    'Undo the combo if it has a partially entered value. 
    If (Err.Number = 2118) And (iErrCount < 3) And Not (cbo Is Nothing) Then 
     cbo.Undo 
     Resume 
    End If 
MsgBox "Error " & Err.Number & ": " & Err.Description 
Resume Exit_Handler 

Мне нужно найти способ предотвратить появление ошибки до тех пор, пока ПОСЛЕ обновления и закрытия frmCity не будет. Любая помощь будет оценена по достоинству.

Answer 1

Хорошо, я наконец-то смог найти способ сделать то, что я пытался. Я нашел большую часть своего ответа на этом посту. https://stackoverflow.com/a/12305777/2360108 Это сообщение дает подпункт для приостановки кода до тех пор, пока субформа не будет закрыта. Но потом я столкнулся с другой проблемой.

Я не разрешал frmCity заполнять новые PK для города & ZIP. Я должен был использовать OpenArgs, чтобы исправить эту проблему.

Я добавил следующее к моему frmProperty NotInList код

Dim NewZIP As String 
     'Create New ZIP ID 
    NewZIP = (DMax("g3ID", "[tblG3ZIP]") + 1) & "|" & (DMax("g2ID", "[tblG2City]") + 1) 

    DoCmd.OpenForm "frmCity", , , , acFormAdd, acNormal, NewZIP 
    WaitTilObjClosed acForm, "frmCity" 
    Response = acDataErrAdded 

Я добавил это событие frmCity OnOpen

'Script for Opening the form as a subform to add new City & ZIP 
Private Sub Form_Open(Cancel As Integer) 
Dim NewIDs 
On Error GoTo Err_Form_Open 

If IsNull(Me.OpenArgs) Then Exit Sub 

'Load new ZIP ID from Property form 
NewIDs = Split(Me.OpenArgs, "|") 
Me!ctrlg3ID.DefaultValue = NewIDs(0) 
Me!ctrlg2ID.DefaultValue = NewIDs(1) 

Exit_Form_Open: 
    Exit Sub 

Err_Form_Open: 
    MsgBox Err.Description 
    Resume Exit_Form_Open 

End Sub 

Я тестировал формы, и они прекрасно работает ,