This article shows you two methods of using the NotInList event to add a new record to a MCCombox on a form. SoftwareForStores provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. SoftwareForStores support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements.
The following examples use the frmContacts form in the VB6 sample to demonstrate two methods of using the NotInList event to add a record to a MCCombox. The NotInList event is triggered when you type a NEW contact in the MccSearchContact (labeled Search Contact:) and Enters are leaves the focus. The first method uses Visual Basic code to programmatically add a new record to the tblContacts table. The second method opens the Contactprops form and lets you add a new record yourself. CAUTION: If you follow the steps in this example, you modify the sample database VeDa_be.mdb. You may want to back up the VeDa_be.mdb file and follow these steps on a copy of the database. Method 1: Using Code to Add a Record to a Table
NOTE: The sample code in this article uses Microsoft Data Access Objects. For this code to run properly, you must reference the Microsoft ActiveX Data Objects 2.8 Library. To do so, click References on the Project menu in the Visual Basic Editor, and make sure that the Microsoft ActiveX Data Objects 2.8 Library check box is selected. You must also select the component MultiColumnActiveX. To do so, click components on the Project menu in the Visual Basic Editor, and make sure that the MultiColumnActiveX check box is selected.
Public cn As New ADODB.Connection Public rs, rs2 As New ADODB.Recordset Public strConnection As String Public strSQL As String Private Sub Form_Load() 'connecting DataBase strConnection = "Driver={Microsoft Access Driver (*.mdb)};" & _ "Dbq=" & App.Path & "\VeDa_be.mdb" cn.ConnectionString = strConnection cn.Open 'properties multicolumnbox With MccSearchContact .CnStr = strConnection .ColumnWidths = "0;25;10;20;10;10" '% of the screenwidth .ColumnHeads = True .RowSource = "SELECT tblContacts.ContactId, tblContacts.Name, tblStreets.Street, tblContacts.nr, tblCities.City, tblContacts.Phone " & _ "FROM tblStreets INNER JOIN (tblCities INNER JOIN tblContacts ON tblCities.CityId = tblContacts.CityId) ON tblStreets.StreetId = tblContacts.StreetId " & _ "ORDER BY tblContacts.Name" .AutoExpand = True End With End Sub Private Sub MccSearchContact_NotInList(Newdata As String) ' Exit this subroutine if the combo box was cleared. If NewData = "" Then Exit Sub ' Confirm that the user wants to add the new customer. Msg = "'" & NewData & "' is not in the list." & vbCr & vbCr Msg = Msg & "Do you want to add it?" If MsgBox(Msg, vbQuestion + vbYesNo) = vbNo Then ' Display a customized message. MsgBox "Please try again." Else ' If the user chose to add a new customer, open a recordset ' using the tblContacts. Set rs = CreateObject("ADODB.Recordset") rs.Open "tblContacts", cn, adOpenDynamic, adLockOptimistic rs.AddNew rs!Name = Newdata rs.Update rs.Close End If End Sub
Public cn As New ADODB.Connection Public rs, rs2 As New ADODB.Recordset Public strConnection As String Public strSQL As String
Private Sub Form_Load() 'connecting DataBase strConnection = "Driver={Microsoft Access Driver (*.mdb)};" & _ "Dbq=" & App.Path & "\VeDa_be.mdb" cn.ConnectionString = strConnection cn.Open 'properties multicolumnbox With MccSearchContact .CnStr = strConnection .ColumnWidths = "0;25;10;20;10;10" '% of the screenwidth .ColumnHeads = True .RowSource = "SELECT tblContacts.ContactId, tblContacts.Name, tblStreets.Street, tblContacts.nr, tblCities.City, tblContacts.Phone " & _ "FROM tblStreets INNER JOIN (tblCities INNER JOIN tblContacts ON tblCities.CityId = tblContacts.CityId) ON tblStreets.StreetId = tblContacts.StreetId " & _ "ORDER BY tblContacts.Name" .AutoExpand = True End With End Sub
Private Sub MccSearchContact_NotInList(Newdata As String) ' Exit this subroutine if the combo box was cleared. If NewData = "" Then Exit Sub ' Confirm that the user wants to add the new customer. Msg = "'" & NewData & "' is not in the list." & vbCr & vbCr Msg = Msg & "Do you want to add it?" If MsgBox(Msg, vbQuestion + vbYesNo) = vbNo Then ' Display a customized message. MsgBox "Please try again." Else ' If the user chose to add a new customer, open a recordset ' using the tblContacts. Set rs = CreateObject("ADODB.Recordset") rs.Open "tblContacts", cn, adOpenDynamic, adLockOptimistic rs.AddNew rs!Name = Newdata rs.Update rs.Close End If End Sub
Public cn As New ADODB.Connection Public rs, rs2 As New ADODB.Recordset Public strConnection As String Public strSQL As String Private Sub Form_Load() 'connecting DataBase strConnection = "Driver={Microsoft Access Driver (*.mdb)};" & _ "Dbq=" & App.Path & "\VeDa_be.mdb" cn.ConnectionString = strConnection cn.Open 'properties multicolumnbox With MccSearchContact .CnStr = strConnection .ColumnWidths = "0;25;10;20;10;10" '% of the screenwidth .ColumnHeads = True .RowSource = "SELECT tblContacts.ContactId, tblContacts.Name, tblStreets.Street, tblContacts.nr, tblCities.City, tblContacts.Phone " & _ "FROM tblStreets INNER JOIN (tblCities INNER JOIN tblContacts ON tblCities.CityId = tblContacts.CityId) ON tblStreets.StreetId = tblContacts.StreetId " & _ "ORDER BY tblContacts.Name" .AutoExpand = True End With End Sub Private Sub MccSearchContact_NotInList(Newdata As String) ' Exit this subroutine if the combo box was cleared. If NewData = "" Then Exit Sub ' Confirm that the user wants to add the new customer. Msg = "'" & NewData & "' is not in the list." & vbCr & vbCr Msg = Msg & "Do you want to add it?" If MsgBox(Msg, vbQuestion + vbYesNo) = vbNo Then ' Display a customized message. MsgBox "Please try again." Else frmContactProps.Show frmContactProps.txtName = Newdata frmContactProps.txtPhone.SetFocus End If End Sub
Private Sub MccSearchContact_NotInList(Newdata As String) ' Exit this subroutine if the combo box was cleared. If NewData = "" Then Exit Sub ' Confirm that the user wants to add the new customer. Msg = "'" & NewData & "' is not in the list." & vbCr & vbCr Msg = Msg & "Do you want to add it?" If MsgBox(Msg, vbQuestion + vbYesNo) = vbNo Then ' Display a customized message. MsgBox "Please try again." Else frmContactProps.Show frmContactProps.txtName = Newdata frmContactProps.txtPhone.SetFocus End If End Sub
Private Sub Form_Load() With mccStreet .CnStr = strConnection .ColumnWidths = "0;10" '% of the screenwidth .RowSource = "select StreetId, Street from tblStreets order by Street" .AutoExpand = True End With With mccZip .CnStr = strConnection .RowSource = "select CityId, zip,City from tblCities order by zip, City" .ColumnWidths = "0;10;10" End With With mccCity .CnStr = strConnection .RowSource = "select CityId, City,zip from tblCities order by City" .ColumnWidths = "0;10;10" .AutoExpand = True End With End Sub
Private Sub MccStreet_KeyDown(KeyCode As Integer, Shift As Integer) mccStreet.ShowDropDown (1) End Sub Private Sub MccStreet_NotInList(Newdata As String) Dim intNewStreetId As Integer Set rs = CreateObject("ADODB.Recordset") rs.Open "Streets", cn, adOpenDynamic, adLockOptimistic rs.AddNew rs!Street = Newdata rs.Update rs.Close rs.Open "Streets", cn, adOpenDynamic, adLockOptimistic rs.MoveLast 'make the RowSource static mccStreet.RowSource = "select StreetId, Street from Streets order by Street" mccStreet.Value = rs!StreetId rs.Close mccStreet.BackColor = &H80000005 nr.SetFocus End Sub Private Sub MccStreet_AfterUpdate() mccStreet.BackColor = &H80000005 nr.SetFocus End Sub Private Sub mccZip_NotInList(Newdata As String) If mccCity.Text > "" Then Set rs = CreateObject("ADODB.Recordset") rs.Open "Cities", cn, adOpenDynamic, adLockOptimistic rs.AddNew rs!City = mccCity.Text rs!zip = Newdata rs.Update rs.Close rs.Open "Cities", cn, adOpenDynamic, adLockOptimistic rs.MoveLast mccCity.RowSource = "select CityId, City, zip from Cities" mccZip.RowSource = "select CityId, zip, City from Cities" mccCity.Value = rs!CityId mccZip.Value = rs!CityId rs.Close mccZip.BackColor = &H80000005 mccCity.BackColor = &H80000005 Else mccCity.SetFocus mccCity.BackColor = &HC0C0FF End If End Sub Private Sub mccZip_KeyUp(KeyCode As Integer, Shift As Integer) mccZip.DropDown End Sub Private Sub mccZip_AfterUpdate() Let mccCity.Value = mccZip.Value txtEmail.SetFocus End Sub Private Sub mccCity_NotInList(Newdata As String) If mccZip.Text > "" Then Set rs = CreateObject("ADODB.Recordset") rs.Open "Cities", cn, adOpenDynamic, adLockOptimistic rs.AddNew rs!City = Newdata rs!zip = mccZip.Text rs.Update rs.Close rs.Open "Cities", cn, adOpenDynamic, adLockOptimistic rs.MoveLast mccCity.RowSource = "select CityId, City,zip from Cities" mccZip.RowSource = "select CityId, zip,City from Cities" mccCity.Value = rs!CityId mccZip.Value = rs!CityId rs.Close mccZip.BackColor = &H80000005 mccCity.BackColor = &H80000005 Else mccZip.SetFocus mccZip.BackColor = &HC0C0FF End If End Sub Private Sub mccCity_KeyUp(KeyCode As Integer, Shift As Integer) mccCity.RowSource = "select CityId, City,zip from Cities order by City" mccCity.DropDown End Sub Private Sub mccCity_AfterUpdate() Let mccZip.Value = mccCity.Value End Sub Sub Update() If mccStreet.Value = "" Then MsgBox "please fill in the street" mccStreet.SetFocus mccStreet.BackColor = &HC0C0FF Exit Sub End If If mccCity.Value = "" Then If Not mccCity.Text > "" Then MsgBox "please fill in the City" mccCity.SetFocus mccCity.BackColor = &HC0C0FF Exit Sub End If If Not mccZip.Text > "" Then MsgBox "please fill in zip" mccZip.SetFocus mccZip.BackColor = &HC0C0FF Exit Sub End If End If If Val(txtContactId) > 0 Then strSQL = "UPDATE tblContacts SET " & _ " Name = '" & txtName.Text & _ "', StreetId = '" & mccStreet.Value & _ "', CityId = '" & mccCity.Value & _ "', Phone = '" & txtPhone.Text & _ "', GSM = '" & txtGsm.Text & _ "', email1 = '" & txtEmail.Text & _ "', email2 = '" & txtEmail2.Text & _ "', Nr = '" & txtNr.Text & _ "', etc = '" & txtEtc.Text & _ "', vat = '" & txtVat.Text & _ "', [Phone work] = '" & txtPhoneWork.Text & _ "', fax = '" & txtFax.Text & _ "', Phone2 = '" & txtPhone2.Text & _ "' Where ContactId = " & Val(txtContactId) cn.Execute strSQL Else Set rs = CreateObject("ADODB.Recordset") rs.Open "tblContacts", cn, adOpenDynamic, adLockOptimistic rs.AddNew If Not IsNull(txtName.Text) Then rs!Name = txtName.Text rs!StreetId = mccStreet.Value rs!CityId = mccCity.Value rs!Phone = txtPhone.Text rs!gsm = txtGsm.Text rs!email1 = txtEmail.Text rs!email2 = txtEmail2.Text rs!nr = txtNr.Text rs!etc = txtEtc.Text rs!vat = txtVat.Text rs.Fields("Phone work") = txtPhoneWork.Text rs!fax = txtFax rs!Phone2 = txtPhone2 rs!note = txtNote rs.Update rs.Close End If txtContactId.BackColor = &HC0FFC0 txtName.BackColor = &HC0FFC0 mccStreet.BackColor = &HC0FFC0 mccZip.BackColor = &HC0FFC0 mccCity.BackColor = &HC0FFC0 txtPhone.BackColor = &HC0FFC0 txtGsm.BackColor = &HC0FFC0 txtEmail.BackColor = &HC0FFC0 txtEmail2.BackColor = &HC0FFC0 txtNr.BackColor = &HC0FFC0 txtEtc.BackColor = &HC0FFC0 txtVat.BackColor = &HC0FFC0 txtPhoneWork.BackColor = &HC0FFC0 txtFax.BackColor = &HC0FFC0 txtPhone2.BackColor = &HC0FFC0 txtNote.BackColor = &HC0FFC0 End Sub Private Sub MccStreet_GotFocus() 'controlling tabkey Dim Control As Control On Error Resume Next 'for controls w/out tabstop For Each Control In Controls Control.TabStop = False Next Control End Sub Private Sub MccStreet_LostFocus() Dim Control As Control On Error Resume Next For Each Control In Controls Control.TabStop = True Next Control End Sub
Private Sub MccStreet_AfterUpdate() mccStreet.BackColor = &H80000005 nr.SetFocus End Sub Private Sub mccZip_NotInList(Newdata As String) If mccCity.Text > "" Then Set rs = CreateObject("ADODB.Recordset") rs.Open "Cities", cn, adOpenDynamic, adLockOptimistic rs.AddNew rs!City = mccCity.Text rs!zip = Newdata rs.Update rs.Close rs.Open "Cities", cn, adOpenDynamic, adLockOptimistic rs.MoveLast mccCity.RowSource = "select CityId, City, zip from Cities" mccZip.RowSource = "select CityId, zip, City from Cities" mccCity.Value = rs!CityId mccZip.Value = rs!CityId rs.Close mccZip.BackColor = &H80000005 mccCity.BackColor = &H80000005 Else mccCity.SetFocus mccCity.BackColor = &HC0C0FF End If End Sub Private Sub mccZip_KeyUp(KeyCode As Integer, Shift As Integer) mccZip.DropDown End Sub Private Sub mccZip_AfterUpdate() Let mccCity.Value = mccZip.Value txtEmail.SetFocus End Sub Private Sub mccCity_NotInList(Newdata As String) If mccZip.Text > "" Then Set rs = CreateObject("ADODB.Recordset") rs.Open "Cities", cn, adOpenDynamic, adLockOptimistic rs.AddNew rs!City = Newdata rs!zip = mccZip.Text rs.Update rs.Close rs.Open "Cities", cn, adOpenDynamic, adLockOptimistic rs.MoveLast mccCity.RowSource = "select CityId, City,zip from Cities" mccZip.RowSource = "select CityId, zip,City from Cities" mccCity.Value = rs!CityId mccZip.Value = rs!CityId rs.Close mccZip.BackColor = &H80000005 mccCity.BackColor = &H80000005 Else mccZip.SetFocus mccZip.BackColor = &HC0C0FF End If End Sub Private Sub mccCity_KeyUp(KeyCode As Integer, Shift As Integer) mccCity.RowSource = "select CityId, City,zip from Cities order by City" mccCity.DropDown End Sub Private Sub mccCity_AfterUpdate() Let mccZip.Value = mccCity.Value End Sub Sub Update() If mccStreet.Value = "" Then MsgBox "please fill in the street" mccStreet.SetFocus mccStreet.BackColor = &HC0C0FF Exit Sub End If If mccCity.Value = "" Then If Not mccCity.Text > "" Then MsgBox "please fill in the City" mccCity.SetFocus mccCity.BackColor = &HC0C0FF Exit Sub End If If Not mccZip.Text > "" Then MsgBox "please fill in zip" mccZip.SetFocus mccZip.BackColor = &HC0C0FF Exit Sub End If End If If Val(txtContactId) > 0 Then strSQL = "UPDATE tblContacts SET " & _ " Name = '" & txtName.Text & _ "', StreetId = '" & mccStreet.Value & _ "', CityId = '" & mccCity.Value & _ "', Phone = '" & txtPhone.Text & _ "', GSM = '" & txtGsm.Text & _ "', email1 = '" & txtEmail.Text & _ "', email2 = '" & txtEmail2.Text & _ "', Nr = '" & txtNr.Text & _ "', etc = '" & txtEtc.Text & _ "', vat = '" & txtVat.Text & _ "', [Phone work] = '" & txtPhoneWork.Text & _ "', fax = '" & txtFax.Text & _ "', Phone2 = '" & txtPhone2.Text & _ "' Where ContactId = " & Val(txtContactId) cn.Execute strSQL Else Set rs = CreateObject("ADODB.Recordset") rs.Open "tblContacts", cn, adOpenDynamic, adLockOptimistic rs.AddNew If Not IsNull(txtName.Text) Then rs!Name = txtName.Text rs!StreetId = mccStreet.Value rs!CityId = mccCity.Value rs!Phone = txtPhone.Text rs!gsm = txtGsm.Text rs!email1 = txtEmail.Text rs!email2 = txtEmail2.Text rs!nr = txtNr.Text rs!etc = txtEtc.Text rs!vat = txtVat.Text rs.Fields("Phone work") = txtPhoneWork.Text rs!fax = txtFax rs!Phone2 = txtPhone2 rs!note = txtNote rs.Update rs.Close End If txtContactId.BackColor = &HC0FFC0 txtName.BackColor = &HC0FFC0 mccStreet.BackColor = &HC0FFC0 mccZip.BackColor = &HC0FFC0 mccCity.BackColor = &HC0FFC0 txtPhone.BackColor = &HC0FFC0 txtGsm.BackColor = &HC0FFC0 txtEmail.BackColor = &HC0FFC0 txtEmail2.BackColor = &HC0FFC0 txtNr.BackColor = &HC0FFC0 txtEtc.BackColor = &HC0FFC0 txtVat.BackColor = &HC0FFC0 txtPhoneWork.BackColor = &HC0FFC0 txtFax.BackColor = &HC0FFC0 txtPhone2.BackColor = &HC0FFC0 txtNote.BackColor = &HC0FFC0 End Sub Private Sub MccStreet_GotFocus() 'controlling tabkey Dim Control As Control On Error Resume Next 'for controls w/out tabstop For Each Control In Controls Control.TabStop = False Next Control End Sub Private Sub MccStreet_LostFocus() Dim Control As Control On Error Resume Next For Each Control In Controls Control.TabStop = True Next Control End Sub