Please find code error

[Guest]

Private Sub Supplier_NotInList(NewData As String, Response As Integer)
On Error GoTo SomethingBadHappened

Dim rstSupplier As ADODB.Recordset
Dim intAnswer As Integer

intAnswer = MsgBox("Add " & NewData & " to the list of suppliers?", _
vbQuestion + vbYesNo)

If intAnswer = vbYes Then
Set rstSuppliers = New ADODB.Recordset
rstSupplier.Open "frmSupplier", CurrentProject.Connection, _
adOpenStatic, adLockOptimistic, adCmdTable

rstSupplierName.AddNew
rstSupplier!Supplier = NewData
rstSupplier.Update
Response = acDataErrAdded
Else
Response = acDataErrDisplay
End If

rstSupplier.Close
Set rstSupplier = Nothing

Exit Sub

SomethingBadHappened:
MsgBox "When trying to process this order, something bad happened" & _
vbCrLf & "Please contact the program vendor and " & _
"report the error as follows" & vbCrLf & _
"Error #: " & Err.Number & vbCrLf & _
"Description: " & Err.Description
Resume Next

End Sub

 

[Brian Bastl]

Sharon,

you've got typos. In some places you have rstSupplier; in other places you
refer to it as rstSuppliers and rstSupplierName.

HTH,
Brian

 

[Guest]

I have tried another way to do this and I am getting a different error
message! Now, it is saying "characters found after end of SQL statement"!!
I have tried for hours to get this to work, please Help!!

Private Sub Supplier_NotInList(NewData As String, Response As Integer)
Dim ctl As Control
Set ctl = Me![Supplier]
' Prompt user to verify they wish to add new value.
If MsgBox("Supplier is not in list. Add it?", vbOKCancel) = vbOK Then
' Set Response argument to indicate that data
' is being added.
Response = acDataErrAdded
ctl.RowSource = ctl.RowSource & ";" & NewData
Else
' If user chooses Cancel, suppress error message
' and undo changes.
Response = acDataErrContinue
ctl.Undo
End If

End Sub

 

[Guest]

Sorry, copied an older version of code.

When I run the code below, I get the desired message and then when I select
"Yes", I get the error message: "Item cannot be found in the collection
corresponding to the requested name or ordinal"

Does this have something to do with the bound column in the combo box
regarding SupplierID and SupplierName.


Private Sub Supplier_NotInList(NewData As String, Response As Integer)
On Error GoTo SomethingBadHappened

Dim rstSupplier As ADODB.Recordset
Dim intAnswer As Integer

intAnswer = MsgBox("Add " & NewData & " to the list of suppliers?", _
vbQuestion + vbYesNo)

If intAnswer = vbYes Then
Set rstSupplier = New ADODB.Recordset
rstSupplier.Open "tblSupplier", CurrentProject.Connection, _
adOpenStatic, adLockOptimistic, adCmdTable
rstSupplier.AddNew
rstSupplier!Supplier = NewData
rstSupplier.Update

End If

rstSupplier.Close
Set rstSupplier = Nothing

Exit Sub

SomethingBadHappened:
MsgBox "When trying to process this order, something bad happened" & _
vbCrLf & "Please contact the program vendor and " & _
"report the error as follows" & vbCrLf & _
"Error #: " & Err.Number & vbCrLf & _
"Description: " & Err.Description
Resume Next

End Sub

 

[Brian Bastl]

Sharon,

What stands out is that you hadn't set your responses. And if you choose not
to add the data, you'll also want to undo what you typed into the control
with Me.Undo.

HTH,
Brian

'******** Slighly revised *********

Private Sub Supplier_NotInList(NewData As String, Response As Integer)
On Error GoTo SomethingBadHappened

Dim rstSupplier As ADODB.Recordset
Dim intAnswer As Integer

intAnswer = MsgBox("Add " & NewData & " to the list of suppliers?", _
vbQuestion + vbYesNo)

If intAnswer = vbYes Then

Set rstSupplier = New ADODB.Recordset
rstSupplier.Open "tblSupplier", CurrentProject.Connection, _
adOpenStatic, adLockOptimistic, adCmdTable
rstSupplier.AddNew
rstSupplier!Supplier = NewData
rstSupplier.Update
Response = acDataErrAdded

Else 'undo what was typed

Me.Undo
Response = acDataErrContinue

End If

rstSupplier.Close
Set rstSupplier = Nothing

BadExit:
Exit Sub

SomethingBadHappened:
MsgBox "When trying to process this order, something bad happened" & _
vbCrLf & "Please contact the program vendor and " & _
"report the error as follows" & vbCrLf & _
"Error #: " & Err.Number & vbCrLf & _
"Description: " & Err.Description
Resume BadExit

End Sub

 

[Brian Bastl]

Sorry, forgot to address your other question.

Does this have something to do with the bound column in the combo box
regarding SupplierID and SupplierName.

Your bound column should be whichever column pertains to SupplierID.

If the RowSource for your Supplier combo is:

Select tblSupplier.SupplierID, tblSupplier.Supplier
From tblSupplier;

then your bound column would be 1, column count = 2, and you'd set the
column widths = 0"; 1"

Brian