The AddItemToCombo Function

Public Function AddItemToCombo( _
    strNewData As String, _
    Optional strFormName As String, _
    Optional strFieldName As String, _
    Optional strRecordSource As String, _
    Optional blnConfirm As Boolean = True, _
    Optional strMsgPrompt As String, _
    Optional strMsgTitle As String _
    ) As Integer

    'Copyright (c) Brendan Reynolds/Timarco Ltd 1999.
    'All rights reserved.
    
    'e-mail [email protected]
    
    'This function adds a new item to a combo box list,
    'either by opening a form for the user to enter the
    'data, or by opening a recordsource to add the data
    'directly, and with or without first prompting the
    'user, depending on the arguments passed to the
    'function. Note that this function works only with a
    'combo box that has a row source type of table/query.
    
    'This function uses DAO code, and requires a reference
    'to the DAO object library, which is not set by default
    'in Access 2000.
    
    'Arguments
    
    'strNewData: The data to be added to the combo box.
    
    'strFormName: The form, if any, to be opened.
    
    'strFieldName: The field in the recordsource to which
    'the data should be added, if adding via a recordset.
    
    'strRecordSource: The table or query to which the data
    'should be added, if adding via a recordset.
    
    'blnConfirm: If True, the user will be prompted to
    'confirm the addition of the new data.
    
    'strMsgPrompt: The text to be displayed in the
    'confirmation message box.
    
    'strMsgTitle: The text to be used for the title of the
    'confirmation message box.
    
    'Return values
    
    'acDataErrAdded if the new data was added, otherwise
    'acDataErrContinue.
    
    'Use (from the Not In List event of a combo box)
    
    'Response = AddItemToCombo(NewData, "frmSomeForm")
        
    'The user is prompted for confirmation, if the user
    'confirms, the form "frmSomeForm" is opened to receive
    'the new data.
    
    'Response = AddItemToCombo( _
    '   strNewData:=NewData, _
    '   strFormName:="frmSomeForm", _
    '   strMsgPrompt:=strSomePrompt, _
    '   strMsgTitle:=strSomeTitle _
    ')
    
    'As above, but the contents of the string variables
    'strSomePrompt and strSomeTitle are substituted for
    'the default prompt and title of the confirmation
    'messagebox.
    
    'Response = AddItemToCombo( _
    '   strNewData:=NewData, _
    '   strFormName:="frmSomeForm", _
    '   blnConfirm:= False _
    ')
    
    'As above, but user is not prompted.
    
    'Response = AddItemToCombo( _
    '   strNewData:=NewData, _
    '   strFieldName:="SomeField", _
    '   strRecordSource:="SomeTableOrQuery" _
    ')
    
    'The user is prompted for confirmation, if the user
    'confirms, a recordset is opened to add the new data
    'to the field "SomeField" in the table or query
    '"SomeTableOrQuery"
    
    'Response = AddItemToCombo( _
    '   strNewdata:=NewData, _
    '   strFieldName:="SomeField", _
    '   strRecordSource:="SomeTableOrQuery", _
    '   strMsgPrompt:=strSomePrompt, _
    '   strMsgTitle:=strSomeTitle _
    ')
    
    'As above, but the contents of the string variables
    'strSomePrompt and strSomeTitle are substituted for
    'the default prompt and title of the confirmation
    'messagebox.
    
    'Response = AddItemToCombo( _
    '   strNewData:=NewData, _
    '   strFieldName:="SomeField", _
    '   strRecordSource:="SomeTableOrQuery", _
    '   blnConfirm:=False _
    ')
    
    'As above, but user is not prompted.
    
    'Note that while all arguments except the strNewData
    'argument are optional, either a form name or a field
    'name and recordsource must be specified, otherwise
    'the function will raise an error (Error 3141).
    
On Error GoTo Err_Routine
        
    Dim intResponse As Integer
    Dim lngErrNum As Long
    
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    
    If blnConfirm = True Then
        
        'Prompt for confirmation.
        If strMsgPrompt = vbNullString Then
        
            'No prompt specified, so use the default.
            strMsgPrompt = "The item '" & strNewData _
                & "' you entered is not in the list. " _
                & "Do you want to add '" & strNewData _
                & "' to the list?"
        End If
        If strMsgTitle = vbNullString Then
        
            'No title specified, so use the default.
            strMsgTitle = "Add Item To List?"
        End If
        intResponse = MsgBox(strMsgPrompt, _
            vbYesNo + vbQuestion, _
            strMsgTitle)
    Else
    
        'No prompt for confirmation.
        intResponse = vbYes
    End If
    If intResponse = vbNo Then
    
        'Don't add the new data.
        AddItemToCombo = acDataErrContinue
    ElseIf strFormName = vbNullString Then
    
        'No form specified, so open a recordset.
        Set db = CurrentDb
        Set rst = db.OpenRecordset("SELECT " _
            & strFieldName & " " _
            & "FROM " & strRecordSource & " " _
            & "WHERE False")
        With rst
            .AddNew
            .Fields(strFieldName) = strNewData
            .Update
            .Close
        End With
        Set rst = Nothing
        db.Close
        Set db = Nothing
        AddItemToCombo = acDataErrAdded
    Else
    
        'Open a form.
        DoCmd.OpenForm FormName:=strFormName, _
            DataMode:=acFormAdd, _
            WindowMode:=acDialog, _
            OpenArgs:=strNewData
        AddItemToCombo = acDataErrAdded
    End If
    
Exit_Routine:
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    db.Close
    Set db = Nothing
    Exit Function
    
Err_Routine:
    lngErrNum = Err.Number
    Select Case Err
        '
    Case Else
        Err.Raise lngErrNum
        Resume Exit_Routine
    End Select
    
End Function

Download this function in plain text format, ready for import into your own Microsoft Access 97 or Microsoft Access 2000 application, here.

home