This function will add a new record to the table you indecate and open the form you indecate
'=======Add Under Option Explicit===================================================================
Private m_rst As Recordset
'Used for all my List filling functions which have worked without fault for 18 years
Private m_IntNew As Integer 'used to test the response from message box
Private Const m_strMsg As String = " Is Not An Item In The List Would You Like To Add It"
'Part Of all list filling funtions message
Private Const m_strUndoMsg As String = " Is Not In the List Undoing Entry"
'Part of the list filling function undo message
Private Const m_strTitle As String = "Undoing Invalid Entry" 'Undo title
'==========================================================================================
Public Function FillListsOneExt(StrItem As String, StrTable As String, _
StrField As String, StrForm As String, IDField As String) As Integer
'=================================================================
'Description: Add Any Item Then open Any form to Display the new record for editing
'Called By: Combo Box After Update
'Calling:
' Response = FillListsOneExt(NewData, "Table", "Field", "Form", "ID")
' If Response = acDataErrContinue Then
' DoCmd.RunCommand acCmdUndo
' End If
'Parameters:
'StrItem = Field Name Form new Date
'StrTable = Table Name To Update
'StrForm = Name Of Form To Open
'IDField = ID Field to Limit form data
'Returns: acDataErrAdded or acDataErrContinue
'Author: Michael Javes
'Editor(s) : None
'Date Created: 2006-2008
'Rev. History: None
'Requirements:
'=================================================================
Dim NewID As Long
On Error GoTo Err_HandleErr
m_IntNew = MsgBox(StrItem & m_strMsg, vbInformation + vbYesNo, "Item Not In List")
If m_IntNew = vbYes Then
Set m_rst = CurrentDb.OpenRecordset(StrTable)
m_rst.AddNew
m_rst(StrField) = StrItem
NewID = m_rst(IDField)
m_rst.Update
FillListsOneExt = acDataErrAdded
m_rst.Close
Set m_rst = Nothing
DoCmd.OpenForm StrForm, , , "[" & IDField & "]=" & NewID, , acDialog, "Adding"
Else
MsgBox StrItem & m_strUndoMsg, , m_strTitle
FillListsOneExt = acDataErrContinue
End If
Exit_HandleErr:
Exit Function
Err_HandleErr:
Select Case Err.Number
Case Else
MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
Resume Exit_HandleErr
Resume
End Select
End Function