RE: Add Record with combo box

I hope you're not as frustrated as I am now.... Thank you for the great code.
I'm sad to say it still gives the same error. I did check to be sure I had a
reference to DAO 3.6 Object Library. I suspect that it might have something
to do with the form or the parameters on the combo box, but I don't know what
it is. I'll outline that information below in case it helps.

My combo box is on a form which is based off of a query. I tested to see if
a new form - based off of the main table which feeds the query - would give
the same error. It did. As I understand it the properties that need to be
addressed are:

The combobox must have it's RowSource set to either a table or a query -
which it is.

The combobox must have the RowSourceType set to Table/Query - which it is.

You must set the Limit To List property to Yes - which it is.

The combo box is bound to the first field (autonumber ID field) and displays
the second field (text). I have tested to see if changing either of these
influences the error - neither does.

HTH

"Chris" wrote:

Here is some code from the Developer's Handbook that I've adapted to fit your
existing code. It uses a recordset instead of an update query. Just for
kicks, see if it works. Make sure you have a referrence set for Microsoft DAO
x.x Object Library.

Private Sub JCTARSectionLayer1ID_NotInList(NewData As String, _
Response As Integer)

Dim strMsg As String
Dim rst As DAO.Recordset
Dim db as DAO.Database

strMsg = " ' " & NewData & " ' is not in the list. "
strMsg = strMsg & "Would you like to add it?"
If vbNo = MsgBox(strMsg, vbYesNo + vbQuestion, _
"New Value") Then
Response = acDataErrDisplay
Else
Set db = CurrentDb()
Set rst = db.OpenRecordset("tblJCTARSectionLayer1")
rst.AddNew
rst("SectionLayer1Text") = NewData
rst.Update
Response = acDataErrAdded
rst.Close
End If

Set db = Nothing
Set rst = Nothing
End Sub

"WestWingFan" wrote:

Chris,

Golly, I wish I could say this was it, but the call is all on one line. I'm
mystified.

"Chris" wrote:

Is this procedure call all on one line in your code? If not, you have to put
an underscore at the end of the first line. Ex:
Private Sub JCTARSectionLayer1ID_NotInList(NewData As String, _
Response As Integer)

"WestWingFan" wrote:

Chris,

Thanks for the quick responses. Nothing is missing. I exited and re-entered.
The flagged line is the very first one (Private Sub
JCTARSectionLayer1ID_NotInList(NewData As String, Response As Integer)). Does
that help?

"Chris" wrote:

Since the error occurs when you are compiling, in the VBA Window, go to Tools
References and make sure that none of the checked references have
"Missing:" in front of them. Also, usually if there is a compile time error,
the line of code causing the error will be highlighted.

"WestWingFan" wrote:

Chris,

Thanks for your help. I ran the following code line by line and none of the
lines gives me the error. When I go to compile, I still get it.... Any
thoughts?

Private Sub JCTARSectionLayer1ID_NotInList(NewData As String, Response As
Integer)

Dim strSQL As String
Dim Msg As String

On Error GoTo Handle_Error:

If Len(NewData) <> 0 Then
Msg = "'" & NewData & "' is not currently in the list." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"

If MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Layer...") = vbYes Then
strSQL = "Insert Into tblJCTARSectionLayer1 ([SectionLayer1Text])
" & _
"values ('" & NewData & "');"
CurrentDb.Execute strSQL, dbFailOnError
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If

End If

Exit Sub

Handle_Error:
MsgBox "The following error has occurred: " & Err.num & vbCrLf &
Err.Description

End Sub


"Chris" wrote:

I have not tested this code but try:
Private Sub JCTARSectionLayer1ID_NotInList(NewData As String, Response As
Integer)

Dim strSQL As String
Dim Msg As String

On Error GoTo Handle_Error

If Len(NewData) <> 0 Then

Msg = "'" & NewData & "' is not currently in the list." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"

If MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Layer...")= vbYes Then
strSQL = "Insert Into tblJCTARSectionLayer1 ([SectionLayer1Text])
" & _
"values ('" & NewData & "');"
CurrentDb.Execute strSQL, dbFailOnError
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If

End If

ExitPoint:
Exit Sub

HandleError:
msgbox "The following error has occurred: " & err.num & vbcrlf &
err.description

End Sub

If you are still getting an error, set a break point and step through the
code to see which line is causing the error and post back with that
information.

"WestWingFan" wrote:

I'm trying to code the not in list event of a combo box. I keep getting the
"Invalid procedure call or argument" error. I have the combo box properties
set to Limit to list, the row source set to Table/Query. The bound column is
1 (autonumber) and the table only has one other field. So, except for the
error, I think I'm doing everything right. What did I miss? Thanks in advance
for the help!


Private Sub JCTARSectionLayer1ID_NotInList(NewData As String, Response As
Integer)

Dim strSQL As String
Dim i As Integer
Dim Msg As String

'Exit this sub if the combo box is cleared
If NewData = "" Then Exit Sub

Msg = "'" & NewData & "' is not currently in the list." & vbCr & vbCr
Msg = Msg & "Do you want to add it?"

i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Layer...")
If i = vbYes Then
strSQL = "Insert Into tblJCTARSectionLayer1 ([SectionLayer1Text]) "
& _
"values ('" & NewData & "');"
CurrentDb.Execute strSQL, dbFailOnError
Response = acDataErrAdded
Else
Response = acDataErrContinue
End If

End Sub

.

Relevant Pages

  • Project Error
    ... Private Declare Sub Sleep Lib "Kernel32" ... Dim strDataSrc As String ...
    (microsoft.public.vb.bugs)
  • Re: Is there a way to prevent a RichTextBox from scrolling?
    ... Private _isRegex As Boolean ... Public Sub New(ByVal thispattern As String, ... Dim entry As tDict ...
    (microsoft.public.dotnet.framework.windowsforms.controls)
  • Excel Listing tool using VB
    ... Sub ListFiles2() ... Dim directories() As String, CurrentDirectory As String ... Dim dirtopaste, dirok ...
    (microsoft.public.vb.general.discussion)
  • Form Error
    ... SMSDS_CallerID As String ... Private Declare Sub Sleep Lib "kernel32" ... Dim ComString As String ... Dim AppPath As String, FreeFileNo% ...
    (microsoft.public.vb.bugs)
  • Re: Encrypt/hide Password
    ... Public Sub New(ByVal strCryptoName As String) ... ' instantiated crypto class. ... Dim fsKey As New FileStream(strSaveToPath, FileMode.OpenOrCreate, _ ...
    (microsoft.public.scripting.wsh)