NOTINLIST

  • Thread starter Thread starter Ruth
  • Start date Start date
R

Ruth

Hi,there
I just started with ACCESS coding. I tried to use a combo
box to input BASEID but when I move mouse to input
BASEDESC it incurs "keyword duplicate" error. The code is
as follows:

Private Sub BASEID_NotInList(NewData As String, Response
As Integer)
Dim db As DAO.Database
Dim Rs As DAO.Recordset
Dim Msg As String
On Error GoTo Err_BASEID_NotInList
If NewData = "" Then Exit Sub
Msg = "'" & NewData & "' is not in the list." & vbCr
& vbCr
Msg = Msg & "Do you want to add it?"
If MsgBox(Msg, vbQuestion + vbYesNo) = vbNo Then
Response = acDataErrContinue
MsgBox "Please try again."
Else
Set db = CurrentDb
Set Rs = db.OpenRecordset("BASES", dbOpenDynaset)
Rs.FindFirst BuildCriteria("BASEID", dbText,
NewData)
Do Until Rs.NoMatch
NewData = InputBox("BASEID " & NewData & "
already exists." & _
vbCr & vbCr & Msg, NewData & " Already
Exists")
Rs.FindFirst BuildCriteria("BASEID", dbText,
NewData)
Loop
Rs.AddNew
Rs![BASEID] = NewData
Rs![BASEDESC] = ""
Rs.Update
Response = acDataErrAdded
End If
Exit_BASEID_NotInList:
Exit Sub
Err_BASEID_NotInList:
MsgBox Err.Description
Response = acDataErrContinue
End Sub

Thanks a lot
 
Hi Ruth:

There are 2 ways of doing this that I like to use. One is to simply add the
single combobox value to the recordset as a new record with minimal querying
of the user:

1) Private Sub Combo92_NotInList(NewData As String, Response As Integer)
Set dbs = CurrentDb
strAuth = "'" & NewData & "' is not in the list. "
strAuth = strAuth & "Would you like to add it?"
If MsgBox(strAuth, vbYesNo + vbQuestion, "New Group Diagnosis") = vbNo Then
Response = acDataErrDisplay
Else
Set rst = dbs.OpenRecordset("DXGRPLU")
rst.AddNew
rst![DIAGNOSIS] = NewData
rst.UPDATE
Response = acDataErrAdded
rst.Close
dbs.Close
End If
End Sub

Now, if you have a more elaborate dataentry requirement, s.a. adding
zipcodes (i.e. need to fill in the zip code field, the city, and the state),
you might wish to bring up a popup form to allow the user to fill in stuff.
Since you have a BASEDESC field to be filled, this may be the best method
for you:

2) Private Sub BASEID_NotInList(NewData As String, Response
As Integer)
Dim strAuth As String, DX As String, CPT As String, intComma As Integer,
intReturn As Integer
On Error GoTo C194ERR
'Partially from: "Running Microsoft Access 97" (Microsoft Press)
'Copyright 1997 John L. Viesas, pages 803-805.
'and from the Access97 On Line Help
strAuth = NewData
intComma = InStr(strAuth, " ")
If intComma = 0 Then
DX = strAuth
Else
DX = Left(strAuth, intComma - 1)
CPT = Mid(strAuth, intComma + 2)
End If
intReturn = MsgBox("Phrase " & Chr(34) & strAuth & Chr(34) & " is not in
the system." & " Do you want to add this phrase?", vbQuestion + vbYesNo,
"Add Phrase Form")
If intReturn = 7 Then 'the next 4 lines permit you to
breakout of the ComboBox leaving the
Me!BASEID.LimitToList = False
Response = acDataErrContinue
Exit Sub
Else 'bring up form "DxAdd" that allows user to fill in
other data for new record in lookup table
DoCmd.OpenForm FormName:="DxAdd", DataMode:=acAdd, WindowMode:=acDialog,
OpenArgs:=strAuth
Response = acDataErrAdded
Exit Sub
Response = acDataErrDisplay
End If
Me.Refresh
Me![NextField].SetFocus
Exit Sub
C194ERR:
MsgBox "An error has occurred! If it persists, please notify software
administrator.", vbCritical
Exit Sub

End Sub

------------------------
IMPORTANT!

Now, in the form that you bring up to add the new record, make sure the
following code is included:

Private Sub Form_Open(Cancel As Integer)
Dim strEmployeeName As String
' If OpenArgs property contains the text, find corresponding
' record and display it on form. For example,
' if the OpenArgs property contains "Callahan", move to first
' "Callahan" record.
strEmployeeName = Forms!DxAdd.OpenArgs
If Len(strEmployeeName) > 0 Then
DoCmd.GoToControl "Dx"
Me![DX] = strEmployeeName
End If
[CPT].SetFocus 'go to the first open textbox on this popup form... [CPT]
End Sub

Regards,
Al


Ruth said:
Hi,there
I just started with ACCESS coding. I tried to use a combo
box to input BASEID but when I move mouse to input
BASEDESC it incurs "keyword duplicate" error. The code is
as follows:

Private Sub BASEID_NotInList(NewData As String, Response
As Integer)
Dim db As DAO.Database
Dim Rs As DAO.Recordset
Dim Msg As String
On Error GoTo Err_BASEID_NotInList
If NewData = "" Then Exit Sub
Msg = "'" & NewData & "' is not in the list." & vbCr
& vbCr
Msg = Msg & "Do you want to add it?"
If MsgBox(Msg, vbQuestion + vbYesNo) = vbNo Then
Response = acDataErrContinue
MsgBox "Please try again."
Else
Set db = CurrentDb
Set Rs = db.OpenRecordset("BASES", dbOpenDynaset)
Rs.FindFirst BuildCriteria("BASEID", dbText,
NewData)
Do Until Rs.NoMatch
NewData = InputBox("BASEID " & NewData & "
already exists." & _
vbCr & vbCr & Msg, NewData & " Already
Exists")
Rs.FindFirst BuildCriteria("BASEID", dbText,
NewData)
Loop
Rs.AddNew
Rs![BASEID] = NewData
Rs![BASEDESC] = ""
Rs.Update
Response = acDataErrAdded
End If
Exit_BASEID_NotInList:
Exit Sub
Err_BASEID_NotInList:
MsgBox Err.Description
Response = acDataErrContinue
End Sub

Thanks a lot
Click to expand...
 
Back
Top