Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

GLOBAL Not In List Event Handler

Combo Boxes

GLOBAL Not In List Event Handler

by  TheAceMan1  Posted    (Edited  )
To All . . . . .

This routine is a [blue]Global Extension[/blue] of the [blue]NotInList Event[/blue] for a combobox. [blue]You can call it from any combobox on any form or subform[/blue] without having to write the usual routine everytime.

The [blue]calling NoInList Event[/blue] needs to supply three arguements to the routine, [blue]only two of which come from the user[/blue], and its still general enough to be included in a library.

The routine prompts the user with the usual msgbox. Since I always like things [blue]lookin good[/blue], I always use the old 97 style (1st line bold) display format. If this is not perferred, you'll have to recode the msgbox portion & variables. So, in a module in the module window, add the following to the declarations section:
Code:
[blue]Public Msg As String 'Your Message
Public Style As Integer 'Example: vbCritical + vbOKOnly
Public Title As String ' TitleBar text of MsgBox Window
Public Const NL As String = vbNewLine 'Next Line
Public Const DL As String = NL & NL ' Skip a line
Public Const DQ As String = """"[/blue]
Add the following MsgBox handler routine to the same module(if ya like you can use it for all msgboxes. Just assign proper to the Msg, Style, & Title variables. Then call the uMsg function. It works exactly the same as MsgBox and returns the same values):
Code:
[blue]Public Function uMsg() As Integer
   Beep
   uMsg = Eval("MsgBox(" & DQ & Msg & DQ & "," & Style & "," & DQ & Title & DQ & ")")
End Function[/blue]
Add the following AddToList routine to the same module ([purple]this is the Global Routine[/purple]):
Code:
[blue]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
   
   [green]'Since were just adding one record, the SQL loads only one record
   'in the recordset. This prevents a large number of records
   'from loading and taxing resources.[/green]
   SQL = "SELECT TOP 1 * FROM " & tblName & ";"
   
   frmMainName = Screen.ActiveForm.Name
   curFrmName = curForm.Name
   CurCbxName = Screen.ActiveControl.Name
   
   [green]'Acquire all form/subform names from Main Form to[/green]
   [green]'subform in the chain, that holds the calling combobox.[/green]
   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
   
   [green]'Setup Object Reference to each form/subform.[/green]
   [green]'User can now reference any form in the chain.[/green]
   [green]'frmMain - the main form.[/green]
   [green]'sfrm1 - 1st subform level.[/green]
   [green]'sfrm2 - 2nd subform level.[/green]
   [green]'sfrm3 - 3rd subform level.[/green]
[green]   'Note: subforms only go as deep as user has desgined.[/green]
   [green]'Remaining sfrms will be empty.[/green]
   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
   
   [green]'Setup Object Reference to the Combobox.[/green]
   [green]'User can reference the Combobox for other data.[/green]
   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

   [green]'The Global NotInList Event[/green]
   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[/blue]
Now . . . . in the NotInList event of each combobox, add the following code. You have to prescribe names in [purple]purple[/purple]:
Code:
[blue]   [green]'YourTableName? - table you wish to add the new data to.[/green]
   [green]'YourFieldName? - the field in the table that will receive the data.[/green]
   If AddToList(Me, "[purple][b]TableName[/b][/purple]", "[purple][b]FieldName[/b][/purple]") Then
      Response = acDataErrAdded
   Else
      Response = acDataErrContinue
      Me![purple][b]ComboBoxName[/b][/purple].Undo [green]'Optional. Restores previous text.[/green]
   End If[/blue]
Thats it! Give it a spin . . . . .

Thanks to [blue]FancyPrairie[/blue] and others for the inspiration!
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top