I have a form where the user enters data "last name"
I am trying to put a code together that checks if the data entered for "last name" already exists in a database, and if it does, for a message box to appear advising the user that the last name already exists, and then giving them the option on whether they would like to continue in adding that "last name" into the database.
ive written the code several different ways, with if statements and dlookup, but it doesn't seem to be working
Check this out
Private Sub btn_Click()
'variable declaration
Dim lastName As String
Dim cnt As Long
Dim retVal As Variant
'get textbox value into variable. Nz function checks for null and replaces it with empty string in case its nulll
lastName = Nz(Me.txtLastName, "")
'dcount function checks the count of lastname in tblUser
If DCount("*", "tblUser", "LastName='" & lastName & "'") > 0 Then
retVal = MsgBox("Name already exist. Do you want to continue?", vbYesNo)
If retVal = vbYes Then
'your insert statement
Else
'
End If
End If
End Sub
Related
I am working on a database for our company. One of the big things they want this database to do is to create reminders and emails based on changed fields and newly created records. For example, when the user puts a date in the First_Meeting field, an event should be triggered that will create 3 reminders on an Outlook Calendar. As a second example, when a new record is created in the Contract table, an event should be triggered to create 2 reminders in an Outlook Calendar and 2 Outlook emails.
I have the logic to do all of this, but I am trying to figure out the best way to handle the events. It is important that the trigger happens on whatever form the First_Meeting field is updated. If I do a form field event, I have to make sure I add the code to all forms that include that field. I am wondering if there is a way to do this with Class modules so that I could fire an event on a table field or record. I have not done any OO, but looked into it a little bit years ago, so I have a very vague understanding of how it works. I apologize that my question is somewhat non-specific, but I don’t want to spend a lot of time on the learning curve of OO & Class Modules only to find out that what I am trying to do cannot be done. On the other hand, if I could do all of this in one place and not have to worry about it going forward that would be well worth any time spent!
My question is: Can I create a class on a table field that would fire an event anytime that field is edited? And can I create a class on a table (or table record) that would fire any time there is a record inserted into the table? What is the logic to accomplish this?
I am using a table to hold all of the items that will be created based on the field that is updated, or record that is created.
I am using Access 2016. Thanks in advance for any help you can give me!!!
Kim
This is the event code I am currently using for the First_Meeting Event:
'This code calls a form to select the reminders to create
Private Sub First_Meeting_AfterUpdate()
Dim strSql As String
Dim strWhere As String
Dim strOrderBy As String
Dim intRecordCount As Integer
'Save any changes to data before selecting appointments to set
If Me.Dirty Then
Me.Dirty = False
End If
'The "Where" keyword is not included here so it can be used for the DCount function
strWhere = " [Appt Defaults].[Field Name]='First Meeting Date'"
strOrderBy = " ORDER BY [Appt Defaults].[Order for List], [Appt Defaults Child].[Date Offset]"
strSql = "SELECT Count([Appt Defaults Child].ID) AS CountOfID " & _
"FROM [Appt Defaults] INNER JOIN [Appt Defaults Child] ON [Appt Defaults].ID = [Appt Defaults Child].ReminderID"
intRecordCount = DCount("ReminderID", "qDefaultAppts", strWhere)
If intRecordCount > 0 Then
DoCmd.SetWarnings False
'Delete records from the Temp table
DoCmd.RunSQL "Delete * From TempApptToSelect"
'Add the "Where" keyword to be used in the query
strWhere = "Where " & strWhere
strSql = CurrentDb.QueryDefs("[qAddApptsToTemp-MinusCriteria]").SQL
'The ";" symbol is added to the end of the query so it needs to be stripped off
strSql = Replace(strSql, ";", "")
strSql = strSql & strWhere & strOrderBy
DoCmd.RunSQL strSql
'Flag all of the events in the Temp Table as Selected
DoCmd.RunSQL "UPDATE TempApptToSelect SET TempApptToSelect.IsSelected = -1"
DoCmd.SetWarnings True
DoCmd.OpenForm "Reminders - Select Main", , , , , , OpenArgs:=Me.Name
End If
End Sub
'This code is from the form where the reminders are selected
Private Sub cmdCreateReminders_Click()
' This Routine copies all of the selected default records from the Appt Defaults tables and copies them to the Reminder Tables
'
Dim rstReminderDefaults As Recordset
Dim rstReminders As Recordset
Dim nID As Integer
Dim dtStartDate As Date
Dim dtStartTime As Date
Dim dtEndTime As Date
Dim strProjectName As String
Dim strProjectAddress As String
Dim strApptArea As String
Dim iCount As Integer
' The calling form has the info needed to set the values for the reminders
' The form "frmCalendarReminders" is generic and will be on all forms that need to set reminders
txtCallingForm = Me.OpenArgs()
'The form recordset is a temp query created from the calling routine which determines the record filter
Set rstReminders = Forms(txtCallingForm)!frmCalendarReminders.Form.RecordsetClone
Set rstReminderDefaults = CurrentDb.OpenRecordset("qApptsToSet")
nID = Forms(txtCallingForm)!ID
strApptArea = Left(rstReminderDefaults![Appt Area], 8)
Select Case strApptArea
Case "Projects"
strProjectName = Forms(txtCallingForm)!txtProjectName
strProjectAddress = Forms(txtCallingForm)!txtProjectAddressLine & vbCrLf & Forms(txtCallingForm)!txtProjectCityLine
With rstReminderDefaults
Do While Not .EOF
'If this reminder has not already been created
If DCount("ID", "PR_Child-Reminders", "[Project ID] =" & Forms(txtCallingForm)![ID] & " And [ReminderChildID]= " & ![ReminderChildID]) = 0 Then
rstReminders.AddNew
'Initialize fields with values from defaults
rstReminders![ReminderChildID] = ![ReminderChildID]
rstReminders![Project ID] = nID
rstReminders![Reminder Type] = ![Outlook Item Type]
rstReminders![Reminder Subject] = ![Subject]
rstReminders![Reminder Text] = ![Body]
rstReminders![Invited] = ![Invite]
rstReminders![Email CC] = ![Email CC]
rstReminders!Calendar = !CalendarID
rstReminders!Color = !ColorID
Select Case ![Appt Type]
.
.
Case "First Meeting"
If Not IsNull(Forms(txtCallingForm)!dtFirstMeeting) Then
'dtStartDate will be used later to fill in Placeholder field in Subject and Body of Calendar and Email Items
dtStartDate = Forms(txtCallingForm)!dtFirstMeeting
rstReminders![Reminder Date] = dtStartDate + ![Date Offset]
Else
'Quit working on this reminder since it has invalid conditions
MsgBox "No date has been set for the " & ![Appt Type] & " so reminders cannot be created"
rstReminders.CancelUpdate
GoTo NextLoop
End If
End Select
.
rstReminders.Update
CreateOrSend (txtCallingForm)
.
NextLoop:
.MoveNext
Loop
End With
End Select
DoCmd.Close
End Sub
‘This code is used to create the reminder or email
Sub CreateOrSend(CallingForm)
Dim bError As Boolean
Dim strName As String
Dim strSubject As String
Dim strBody As String
Dim strType As String
Dim strAttendees As String
Dim strCC As String
Dim strColorCategory As String
Dim dtStartDate As Date
Dim dtEndDate As Date
Dim strReminderText As String
Dim strLocation As String
Dim decDuration As Single
With Forms(CallingForm)!frmCalendarReminders.Form
'bError will be used to determine if the calendar item is created without error
bError = False
If !cmbReminderType = "Calendar" Then
strName = !cmbCalendar.Column(2)
strSubject = !txtReminderSubject
If Not IsNull(!txtReminderNote) Then
strBody = !txtReminderNote
Else
strBody = ""
End If
If Not IsNull(!txtInvite) Then
strAttendees = !txtInvite
Else
strAttendees = ""
End If
strColorCategory = !cmbColor.Column(1)
dtStartDate = !dtStartDate & " " & !dtStartTime
dtEndDate = !dtEndDate & " " & !dtEndTime
If Not IsNull(!txtReminderNote) Then
strReminderText = !txtReminderNote
Else
strReminderText = ""
End If
strLocation = IIf(IsNull(.Parent!txtProjectAddressLine), ".", .Parent!txtProjectAddressLine & ", " & .Parent![Project City])
' Parameter Order: strName, strSubject, strBody, strAttendees, strColorCategory, dtStartDate, dtEndDate, strReminderText Optional: strLocation, decDuration
Call CreateCalendarAppt(bError, strName, strSubject, strBody, strAttendees, strColorCategory, dtStartDate, dtEndDate, strReminderText, strLocation)
If bError = False Then
!dtCreatedItem = Date
Else
MsgBox "***** YOUR APPOINTMENT FAILED ******"
End If
Else
If Not IsNull(!txtReminderNote) Then
strBody = !txtReminderNote
Else
strBody = ""
End If
strSubject = !txtReminderSubject
If Not IsNull(!txtInvite) Then
strAttendees = !txtInvite
strCC = !txtEmailCC
SendCustomHTMLMessages strAttendees, strCC, strSubject, strBody
!dtCreatedItem = Date
Else
MsgBox "There were no email addresses to send this message to"
End If
End If
End With
End Sub
Unfortunately, there is no way to accomplish what you want. Although Access has something like "Data Macros", there is no way to to run a VBA procedure from there.
But don't be afraid of using event procedures in your forms. You don't have to copy all your existing code to each and every event procedure. You can place the existing code in a standard module, and in the forms, use very short event procedures that call these procedures in the standard modules. This still makes the main routines easy to maintain.
I don't agree with Wolfgang.
Of course I would suggest using MSSQL Server as backend, but with Access and the Data-Macros you can update a timestamp field in the underlying tables that updates on every change.
In addition run a script on a server (I don't knpw what intervall would be sufficent for you) every x minutes and check if row was updated since last run of script (compare timestamp)..
If true run your tasks.
If this is not an option we can talk about intercepting form-events with a class and WithEvents but this will need more effort to implement.
The Solution
The solution was to not try and capture the errors but do the error handling myself as part of the Add New Record command button:
Private Sub buttonNewRecord_Click()
Dim ErrorInt As Integer
Dim TeleCheck As Variant
Name.SetFocus
If Name.Text = "" Then
MsgBox "Name is missing!"
ErrorInt = ErrorInt + 1
End If
TeleCheck = DLookup("[Telephone]", "tblColdCallLog", "[Telephone] = '" & Me.Telephone & "'")
If Not IsNull(TeleCheck) Then
MsgBox "Telephone number already exists in the table!"
ErrorInt = ErrorInt + 1
End If
If ErrorInt < 1 Then
DoCmd.GoToRecord , , acNewRec
MsgBox "Record Added!"
End If
End Sub
Original Post:
What I Have:
I have created a simple Access 2013 Form used to input data into a table. On the Form, the user enters data into the fields and clicks on a button made using the Command Button Wizard to Add New Record.
The form has one required field, [Name], and one field set to 'Index: Yes (No Duplicates)', [Telephone Number]. In the Form, this correctly produces error messages if the [Name] field is empty or there is a duplicate number detected in the [Telephone] field that is also in the table.
What I Am Trying To Do:
The error messages that appear are not user friendly. I would like to replace them with custom error messages and if there are no errors, maybe a message that says all went well.
What I Have Tried:
On the Form properties, Events tab, in 'On Error', [Event Procedure]:
Private Sub Error_Sub(DataErr As Integer, Response As Integer)
If DataErr = 3022 Then
MsgBox "Duplicate telephone number found in table!"
Response = acDataErrContinue
End If
If DataErr = 3314 Then
MsgBox "Name is missing!"
Response = acDataErrContinue
End If
End Sub
This works but only when you close the Form... When you click the 'Add New Record' Command Button, it simply shows the default error messages when appropriate.
Maybe I should use the Event 'Before Update'? I can't seem to use the same VBA script. I'm not allowed to define DataErr or Response. So, I'll use an Expression instead:
=IIf(Error(3022),MsgBox("Duplicate telephone number found in table"))
=IIf(Error(3314),MsgBox("Name is missing"))
This works... but when there is no error. Even if there is a name in the [Name] field, the error shows but at least it replaces the default error message.
Let's put it in the button itself? I'll have to use the Macro Builder to edit it. It's a bit hard to copy and paste this one so I'll simplify:
OnError GoTo Error_Handling
GoToRecord New
If [MacroError]<>0 Then
MsgBox = "[MacroError].[Description]"
End If
Error_Handling:
If Error(3022) Then
MsgBox = "Duplicate telephone number found in table!"
End If
If Error(3314) Then
MsgBox = "Name is missing!"
End If
This does the same as the 'Before Update' event; replaces the default error message but regardless of whether or not the error message should be triggered in the first place.
What am I doing wrong? I get the feeling it's something really simple. I've tried a variety of other combinations and endless Googling but I feel stumped.
Private Sub buttonNewRecord_Click()
Dim ErrorInt As Integer
Dim TeleCheck As Variant
Name.SetFocus
If Name.Text = "" Then
MsgBox "Name is missing!"
ErrorInt = ErrorInt + 1
End If
TeleCheck = DLookup("[Telephone]", "tblColdCallLog", "[Telephone] = '" & Me.Telephone & "'")
If Not IsNull(TeleCheck) Then
MsgBox "Telephone number already exists in the table!"
ErrorInt = ErrorInt + 1
End If
If ErrorInt < 1 Then
DoCmd.GoToRecord , , acNewRec
MsgBox "Record Added!"
End If
End Sub
I been working on the following code to when the user click on the button to save and go new record that Access locates the highest client id used by set location and then adds 1 to it. Prior to saving the record and moving on to new record. While work through other errors, but I can not get past error object required on this line. "Me.ClientID = IIf(DMax("[ClientID]", "tClientinfo", "[CorpsName]=" & "'defaultcorps'") Is Null, 0, DMax("[ClientID]", "tClientinfo", "[CorpsName]=" & "'defaultcorps'")) + 1"
The more i look at the similar questions more confused I get as to what is wrong with the code. Thank you in advance for any suggestions David
Private Sub Save_Record_Click()
'declare variables for default values
Dim defaultinterviewr As String
Dim defaultcorps As String
'Variables get their values
defaultinterviewr = Me.Interviewer.Value
defaultcorps = Me.Corps.Value
'Check to see if ClientID field is Blank.
If IsNull(Me.ClientID) Then
'Check that Corps field is filled in
If IsNull(Me.Corps) Then
MsgBox "Corps must be entered before saving record.", vbOKOnly
Me.Corps.SetFocus
'set client id base on corps by finding the highest id and adding 1 to that number
Else
Me.ClientID = IIf(DMax("[ClientID]", "tClientinfo", "[CorpsName]=" & "'defaultcorps'") Is Null, 0, DMax("[ClientID]", "tClientinfo", "[CorpsName]=" & "'defaultcorps'")) + 1
End If
End If
MsgBox "Done", vbOKOnly
'save record
'DoCmd.RunCommand acCmdSaveRecord
'Me.stateidnum1 = ""
'open new record
'DoCmd.GoToRecord , , acNewRec
'set field default value
'Me.Interviewer.Value = defaultinterviewr
'Me.Corps.Value = defaultcorps
'Me.Child_Subform.Form.AllowAdditions = True
End Sub
I think you need to start off by figuring out if your DMAX() statement is correctly producing results. The next thing I see and which is probably your main culprit is the fact that you are using the Expression IIf() inside VBA. The IIf() expression you are using will work inside a query or in a textbox but VBA has it's own If statement block which you are correctly using in the lines preceding it.
I would actually use the Nz Function to simplify it even more as follows:
UPDATED Based off of your comment below I re-looked at your overall code and noticed that "defaultcorps" is a variable and not a value I originally thought you were trying to filter by. You were wrapping the variable in quotes. My updated answer should work for you.
Me.ClientID = (Nz(DMax("[ClientID]", "tClientinfo", "[CorpsName]= '" & defaultcorps & "'"),0)+1)
I am building a database for cancer research purposes. I have created a form called "inputPI_form". PI stands for "Principal Investigator" aka researcher. tblPI is just a table with first names and last names.
Here is my form:
When you click the "save" button, you run the bottom code.
I have created a composite key in tblPI using both names to prevent any duplicate record. This code prevents duplicate records, but there is no MsgBox showing up:
'Add new PI's name and verify uniqueness with composite key'
Private Sub newPI_Button_Click()
'Declare duplication error number'
Const ERR_DUPLICATE_VALUE = 3022
On Error GoTo Err_Handler
'Declare database object and string variables'
Dim dbs As Database
Dim firstName As String
Dim lastName As String
'Capture firstName and lastName from inputPI_form as strings'
firstName = Forms("inputPI_form")!firstName.Value
lastName = Forms("inputPI_form")!lastName.Value
'Set the dbs object'
Set dbs = CurrentDb
'Excute SQL code to create new record in tblPI by passing firstName and lastName values'
dbs.Execute "INSERT INTO tblPI (lastName, FirstName) VALUES " & _
"('" & lastName & "','" & firstName & "');"
'Update the PI selection combobox on inputProtocolForm'
Forms("inputProtocolForm")!selectionPI.Requery
dbs.Close
DoCmd.Close acForm, "inputPI_form"
Err_Handler:
If Err.Number = ERR_DUPLICATE_VALUE Then
MsgBox ("This PI's name is already taken. Please select another one.")
End If
End Sub
I am not familiar in catching errors in VBA. Am I making an obvious mistake? I would greatly appreciate the community's feedback. Thank you!
Try simplifying your Error Handler. Take out the If statement and replace it was a simple Msgbox Err.number & Err.description. Did you get what you expected?
I have this requirement where I have to check the data based on data given in other fields. I have table with 'N' fields. I should allow user to select 4 fields which are from the table. And then I should get all other fields of that particular record and display it to the user so that he can verify that the data he entered into table is correct. Please help.
Thanks
I have a clearer understanding now of what you require - hopefully this is what you need:
Assume you have a table called 'Phones'
The phones table has three primary fields: Manufacturer, Operating System, and Carrier
In addition to these primary fields there are secondary "spec" fields. For now we have three: ScreenSize, Frequencies, and Price.
I create a form with three combo boxes: ManufacturerFilter, OperatingSystemFilter, and CarrierFilter.
Each combo box's row source is similar to:
SELECT Carrier FROM Phones GROUP BY Carrier ORDER BY Carrier;
Where Carrier is replaced by Manufacturer and [Operating System] respectively.
I then add in all of the secondary fields, each bound to their own respective field.
You can also add in a button called "Retrieve" for now leave the click code blank.
At this point you have a few options. I'll highlight two, but both options will require the following procedure:
Private Function FilterStr() As String
Dim myFilterStr As String
' Include each filter if they are entered
If Nz(Me.ManufacturerFilter, "") <> "" Then myFilterStr = myFilterStr & "[Manufacturer]='" & Me.ManufacturerFilter.Value & "' AND"
If Nz(Me.OperatingSystemFilter, "") <> "" Then myFilterStr = myFilterStr & "[Operating System]='" & Me.OperatingSystemFilter.Value & "' AND"
If Nz(Me.CarrierFilter, "") <> "" Then myFilterStr = myFilterStr & "[Carrier]='" & Me.CarrierFilter.Value & "' AND"
' Remove the last AND statement
If myFilterStr <> "" Then myFilterStr = Mid(myFilterStr, 1, Len(myFilterStr) - 4)
FilterStr = myFilterStr
End Function
This function returns a filter string, based on the combo box options selected.
Option #1: Filter the Recordset
What we want to occur, is when a primary field value is selected, the records are filtered to display only those matching the criteria. Add the following code to the OnClick event of your Retrieve button:
Private Sub RetreiveButton_Click()
Dim myFilterStr As String
myFilterStr = FilterStr
If myFilterStr <> "" Then
Me.Filter = myFilterStr
Me.FilterOn = True
Else
Me.Filter = ""
Me.FilterOn = False
End If
End Sub
So what happens when the button is clicked, is that a filter string is created based on the values selected, and then a filter is applied to the form. If no values are selected in the combo boxes, the filter is cleared and turned off.
Option #2: Find a Record based on the Value
What we want is to select the values in the comboboxes, and then move to the record that matches the criteria.
Add the following code to the onClick event of the retrieve button.
Private Sub RetreiveButton_Click()
Dim rst As DAO.Recordset
Dim myFilterStr As String
myFilterStr = FilterStr()
If myFilterStr = "" Then
MsgBox "No Filter Selected", vbOKOnly, "Error"
Exit Sub
End If
Set rst = Me.RecordsetClone
rst.FindFirst myFilterStr
If rst.NoMatch Then
MsgBox "No Matching Records were found", vbOKOnly, "No Data"
Else
Me.Bookmark = rst.Bookmark
End If
Set rst = Nothing
End Sub
This uses the the same FilterStr() function to return a search string, but uses the recordset's FindFirst method to locate a record. If found, it will move to the record.
Hope that answers your question. As I indicated, the exact behaviour will vary but the underlying principle remains the same.