Per krwill:
>I'm trying to automate a combo box to add a record to the source table
if it's "Not In List". I've tried many different examples and none
have worked.
Combo Box Name = Combo24
Source Table Name = TblHandler
Source Field Name = HandlerLoginID (key column = HandlerID which is an
autonumber)
Thanks
Stan
Here's how I usually do it.
This is some *old* code... hence the "skipLine" instead of
just vbCrlf & vbCrlf, the Integer instead of Boolean and the
magic number "6" instead of vbYes.
Ignore the DebugStackPush, DebugStackPop, and BugAlert stuff - it's just
my own canned error trapping.
At the end of the chain, there's a modal dialog that solicits the new info
from the user and then sets a global semaphore if the user hits "Save"
and nothing abends.
I started cautioning my clients about this type of feature some years back
because with salutations, for instance, users wind up adding variations like
"Mr." "Mr" or "Mister". They tend to have something in mind and they
just don't check the dropdown list for near matches. Trivial, perhaps, with
salutations... but can get real messy with things like firm names, fund names
and so-forth.
-----------------------------------------------------------------------------
Private Sub cboSalutation_NotInList(NewData As String, Response As Integer)
debugStackPush Me.Name & ": cboDonorNameSalutati_NotInList"
On Error GoTo cboDonorNameSalutati_NotInList_err
Response = salutationRecNotInList(NewData)
cboDonorNameSalutati_NotInList_xit:
debugStackPop
On Error Resume Next
Exit Sub
cboDonorNameSalutati_NotInList_err:
bugAlert ""
Resume cboDonorNameSalutati_NotInList_xit
End Sub
-----------------------------------------------------------------------------
Function salutationRecNotInList(theNewData As String) As Integer
debugStackPush mModuleName & ": salutationRecNotInList"
On Error GoTo salutationRecNotInList_err
' Accepts: Data typed into combo box that does not match any of the dropdown's
' entries.
' Returns: An integer that tells the combo box what the result was.
' i.e. Did we add a new entry to the list or bail out...
'
' Notes: 1) Intended to be called by all combo boxes which present
' salutations (e.g. "Mr", "Mrs"...)
Dim myNewData As String
Dim skipLine As String
skipLine = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10)
myNewData = theNewData
If MsgBox("Salutation " & Chr$(34) & myNewData & Chr$(34) & " does not exist."
& skipLine & "Would you like to add it?", 36, "Quick Add?") = 6 Then
If AddRecSalutation(myNewData) = True Then
salutationRecNotInList = DATA_ERRADDED
End If
End If
salutationRecNotInList_xit:
debugStackPop
On Error Resume Next
Exit Function
salutationRecNotInList_err:
bugAlert ""
Resume salutationRecNotInList_xit
End Function
-----------------------------------------------------------------------------
Function AddRecSalutation(theNewData As String) As Integer
debugStackPush mModuleName & ": AddRecSalutation"
On Error GoTo AddRecSalutation_err
' Accepts: New Salutation to be added
' Returns: TRUE or FALSE depending on whether user completed the process
' (they may have pressed the form's CANCEL button or just closed
' the form...)
' Sets: Same field as new salutation ("theNewData") came in on, in case user
' elected to modify the title during the add process
Dim skipLine As String
skipLine = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10)
DoCmd.OpenForm "frmAddRecSalutation", , , , , A_DIALOG, theNewData
AddRecSalutation = gModalAddDialogOutcome
AddRecSalutation_xit:
debugStackPop
On Error Resume Next
Exit Function
AddRecSalutation_err:
bugAlert ""
Resume AddRecSalutation_xit
End Function
-----------------------------------------------------------------------------
--
PeteCresswell
