Public Function AddToList(curForm As Form, tblName As String, _
fldName As String) As Boolean
Dim db As DAO.Database, rst As DAO.Recordset
Dim frmNames As Collection, flg As Boolean, Cbx As ComboBox
Dim frmMainName As String, curFrmName As String, CurCbxName As String
Dim frmMain As Form, sfrm1 As Form, sfrm2 As Form, sfrm3 As Form
Dim n As Integer, lvl As Integer, SQL As String
Set frmNames = New Collection
SQL = "SELECT TOP 1 * FROM " & tblName & ";"
frmMainName = Screen.ActiveForm.Name
curFrmName = curForm.Name
CurCbxName = Screen.ActiveControl.Name
'Acquire all form/subform names from Main Form to
'subform in the chain, that holds the calling combobox.
Do
If curFrmName = frmMainName Then
frmNames.ADD frmMainName
flg = True
Else
frmNames.ADD curForm.Name
Set curForm = curForm.Parent
curFrmName = curForm.Name
End If
Loop Until flg
'Setup Object Reference to each form/subform.
'User can now reference any form in the chain.
'frmMain - the main form.
'sfrm1 - 1st subform level.
'sfrm2 - 2nd subform level.
'sfrm3 - 3rd subform level.
'Note: subforms only go as deep as user has desgined.
'Remaining sfrms will be empty.
For n = frmNames.Count To 1 Step -1
lvl = n - frmNames.Count - 1
If lvl = -1 Then
Set frmMain = Forms(frmNames.Item(n))
ElseIf lvl = -2 Then
Set sfrm1 = frmMain(frmNames.Item(n)).Form
ElseIf lvl = -3 Then
Set sfrm2 = sfrm1(frmNames.Item(n)).Form
Else
Set sfrm3 = sfrm2(frmNames.Item(n)).Form
End If
Next
'Setup Object Reference to the Combobox.
'User can reference the Combobox for other data.
If frmNames.Count = 1 Then
Set Cbx = frmMain(CurCbxName)
ElseIf frmNames.Count = 2 Then
Set Cbx = sfrm1(CurCbxName)
ElseIf frmNames.Count = 3 Then
Set Cbx = sfrm2(CurCbxName)
Else
Set Cbx = sfrm3(CurCbxName)
End If
'The Global NotInList Event
Msg = "'" & Cbx.Text & "' is not in the ComboBox List!" & _
"@Click 'Yes' to add it." & _
"@Click 'No' to abort."
Style = vbInformation + vbYesNo
Title = "Not In List Warning!"
If uMsg() = vbYes Then
Set db = CurrentDb()
Set rst = db.OpenRecordset(SQL, dbOpenDynaset)
rst.AddNew
If IsNumeric(rst(fldName)) Then
rst(fldName) = Val(Cbx.Text)
Else
rst(fldName) = Cbx.Text
End If
rst.Update
AddToList = True
End If
End Function
