• it asks me if I would like to add the new value,
• I click YES,
• and then get the message that the new data has been added
• I click OK
• then I see the combo box is expanded ( the values in the combo box still doesnt have the new value)


• I try clicking on another control
• prompts me again asking if I want to enter the new value(starting the loop all over again)

Private Sub Route_NotInList(NewData As String, Response As Integer)

 Response = Access.acDataErrContinue
    If MsgBox("The route " & Chr(34) & NewData & Chr(34) & " is not in the list of available routes. " & Chr(10) & _
                            "Would you like to enter a new route?", vbYesNo + vbQuestion, "Insert Route?") = vbYes Then
                            
        
        
        'The user clicked yes, so add the route
        Dim strInsertRoute, strRouteNumberText As String
        Dim ResultQuery As Variant
        
        Dim intRouteNumberID As Integer
        
        strInsertRoute = "INSERT INTO ROUTE_NUMBER(ROUTE_NUMBER) VALUES('" & NewData & "');"
        
        ResultQuery = "SELECT @@Identity FROM ROUTE_NUMBER"
    
        ' call sub to run the queries

        
            ' Create Recordset --------------------------------
            Dim rlRecordSet As New ADODB.Recordset            '|
            ' -------------------------------------------------
            
            Call GetRecords(ResultQuery, rlRecordSet, strInsertRoute)
            
            ' Close Recordset --------------------------------
            rlRecordSet.Close                                '|
            Set rlRecordSet = Nothing                        '|
            ' ------------------------------------------------
        
              
        
        MsgBox "Route " & Chr(34) & NewData & Chr(34) & " has been added to the list.", vbOKOnly + vbExclamation _
                , "Route Added!"
        
        Response = Access.acDataErrAdded
    
    Else
        'The user clicked no, so undo what they entered
        
        Response = Access.acDataErrContinue
    
    End If
    
    If Err Then
            MsgBox "An error occurred. Please try again."
            Response = Access.acDataErrContinue
    Else
            Response = Access.acDataErrAdded
            Response = Access.acDataErrContinue
    End If


End Sub

Public Function GetRecords(ByVal strSQL As String, ByRef rstRecordSet As ADODB.Recordset, Optional ByRef actionSQL As Variant = "") As Boolean

        
    
    If (actionSQL <> "") Then

        Dim cmdCommand As New ADODB.Command
        
    End If
    
    
    
    Dim rstCommand As New ADODB.Command


    If (actionSQL <> "") Then
    
    
        MainConnection.Execute actionSQL, dbFailOnError
        
        
        With cmdCommand
            .ActiveConnection = MainConnection
            .CommandText = actionSQL
            .CommandType = adCmdText
        End With

    End If
    
  'Defines our command object

  
  With rstCommand
    .ActiveConnection = MainConnection
    .CommandText = strSQL
    .CommandType = adCmdText
    
  End With

  With rstRecordSet
    .CursorType = adOpenStatic
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open rstCommand
  End With

   
    
    If (actionSQL <> "") Then
        Set cmdCommand = Nothing
     End If
    Set rstCommand = Nothing


End Function

ResultQuery = "SELECT @@Identity FROM ROUTE_NUMBER"

MsgBox rlRecordSet.Fields(0)

quote:

---

Setting Response = acDataErrAdded  suppresses the default Access message, and allows you to add the new value to the combo's list in the event procedure. After you add the value to the list by one of the methods shown below, Access re-queries the combo and re-checks the value against the existing list contents. If the value still isn't in the list, Access displays the default message.

---

Private Sub MyCombo_NotInList(NewData As String, Response As Integer)
    
    On Error GoTo Err_ErrorHandler
    
    ' provide text constants to reduce text later and allow for faster execution
    ' due to added speed from the compilation of constants
    Const Message1 = "The data you have entered is not in the current selection."
    Const Message2 = "Would you like to add it?"
    Const Title = "Unknown entry..."
    Const NL = vbCrLf & vbCrLf
    
    ' conenction and recordset object variables
    Dim cn As Connection
    Dim rs As ADODB.Recordset
    
    ' show message box and evaluate if the user has selected Yes or No
    If MsgBox(Message1 & NL & Message2, vbQuestion + vbYesNo, Title) = vbYes Then
        ' open a connection to the connection object
        Set cn = CurrentProject.Connection
        ' initialise the recordset object
        Set rs = New ADODB.Recordset
        ' using the recordset object
        With rs
            .Open "MyTable", cn, adOpenStatic, adLockPessimistic ' open it
            .AddNew ' prepare to add a new record
            .Fields("MyField") = NewData ' add unfound data into field
            .Update ' update the table
            .Close ' close the recordset connection
        End With
        Response = acDataErrAdded ' confirm record added
    Else
        Me.MyCombo.Undo ' clear the entry in the combobox
        Response = acDataErrContinue ' confirm the record is not allowed
    End If
    
Exit_ErrorHandler:
    ' de-initialise our object variables
    Set rs = Nothing
    Set cn = Nothing
    Exit Sub
    
Err_ErrorHandler:
    ' display error message and error number
    MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
    Resume Exit_ErrorHandler
    
End Sub

With rs
            .Open "MyTable", cn, adOpenStatic, adLockPessimistic ' open it
            .AddNew ' prepare to add a new record
            .Fields("MyField") = NewData ' add unfound data into field
            .Update ' update the table
            .Close ' close the recordset connection
        End With