Class Module to trigger and handle field event & record event - ms-access

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.

Related

Access - VBA - Get row number by criteria

Looking at the following code, how can I receive the row number for a user using the variable usern?
I can check whether a user exists using the DCount function as can be seen. Once received the row number, I would like to use it to navigate to that entry using DoCmd.GoToRecord. GoToRecord itself works already. I just cannot find a way to receive the row number...
Private Sub Form_Current()
Dim usern As String
Dim count As Integer
usern = Environ("Username")
count = DCount("name_", "Fragebogen", "name_='" & usern & "'")
DoCmd.GoToRecord acDataForm, "Fragebogen", acGoTo, 3
End Sub
Have you tried the FindFirst method?
Locates the first record in a dynaset - or - snapshot-type Recordset
object that satisfies the specified criteria and makes that record the
current record.
Dim rs As Recordset
Set rs = Me.RecordsetClone
rs.FindFirst "name_ = '" & Environ("Username") & "'"
If Not rs.NoMatch Then
Me.Bookmark = rs.Bookmark
Else
MsgBox "No match was found.", vbExclamation
Emd If

Access Tab Control - Set Pages Visibilty based on Subform Records

I know how to do this, but wondering if I might be able to write a more elegant solution. I have a form with a tab control. The control has 14 pages, each one, with it's own sub form. One of the pages (pgRequirements) has a subform of requirements, with a combo control "Requirement Type". It is a continuous form, so the user can add as many requirements as they want, for the main record.
There are 9 of those requirements, which have their own tab control page / sub form. I want to set visibility of those tab control pages, based on this parent's sub form requirements. So a current main record, can have multiple sub-requirement records. If any of those match e.g. requirement type A, than page A should be visible, otherwise it should not be.
I need this code to run anytime the main form is loaded, and the detail is made visible (meaning a main record has been chosen from a find form). Also anytime a requirement record is added or removed. The below is assuming that the parent-child links on the main form to subform will limit the requirement records, to just those that are for the current main record.
Here is the simple code, that will do the job, but is probably over-written:
If Me.FKRequirementType.Column(1) = "ReqType1" Then
Me.Parent!pgReqType1.Visible = True
Else
Me.Parent!pgReqType1.Visible = False
End If
If Me.FKRequirementType.Column(1) = "ReqType2" Then
Me.Parent!pgReqType2.Visible = True
Else
Me.Parent!pgReqType2.Visible = False
End If
If Me.FKRequirementType.Column(1) = "ReqType3" Then
Me.Parent!pgReqType3.Visible = True
Else
Me.Parent!pgReqType3.Visible = False
End If
If Me.FKRequirementType.Column(1) = "ReqType4" Then
Me.Parent!pgReqType4.Visible = True
Else
Me.Parent!pgReqType4.Visible = False
End If
Thanks!
EDIT
I turned this into a public function, so I can call it from anywhere. One problem. It's not working lol (small problem). I don't get any errors, but all the tab control pages are visible. When I add a new record, most of them should be hidden. I have a tblReqType table, with all the requirement types. I added a column to this, with the exact name of it's corresponding tab control page name, so I can loop through that table, for all records where that page name is not null, and set their page visible or not, based on the current main record ID having a record-requirement (cross reference table) record for each requirement type.
This is the public function I wrote. Can anyone help me understand what I'm missing in these loops for setting the visibility true (vtrue) vs setting the visibility false (vfalse)
Public Function ShowRequirements()
Dim db As DAO.Database
Dim strRstVTrue As String
Dim rstvTrue As DAO.Recordset
Dim strRstVFalse As String
Dim rstvFalse As DAO.Recordset
Dim strFieldName As String
'Setup the recordset
Set db = CurrentDb
strRstVTrue = "SELECT tblMRecordRequirements.ID, tblMRecordRequirements.FKMC, tblReqType.txtRequirementPage " & _
"FROM tblMRecordRequirements LEFT JOIN tblReqType ON tblMRecordRequirements.FKRequirementType = tblReqType.ID " & _
"WHERE tblReqType.txtRequirementPage Is Not Null AND tblMRecordRequirements.FKMC = " & Nz(Forms!frmMRecords!ID, 0)
strRstVFalse = "SELECT tblReqType.ID, tblReqType.txtRequirementPage, tblMRecordRequirements.FKMC " & _
"FROM tblReqType LEFT JOIN tblMRecordRequirements ON tblReqType.ID = tblMRecordRequirements.FKRequirementType " & _
"WHERE tblReqType.txtRequirementPage Is Not Null AND tblMRecordRequirements.FKMC <> " & Nz(Forms!frmMRecords!ID, 0)
Set rstvTrue = CurrentDb.OpenRecordset(strRstVTrue, dbOpenDynaset, dbSeeChanges)
Set rstvFalse = CurrentDb.OpenRecordset(strRstVFalse, dbOpenDynaset, dbSeeChanges)
strFieldName = "txtRequirementPage"
Do While Not rstvTrue.EOF
Forms!frmMRecords.tbMRecordSubs.Pages(rstvTrue.Fields(strFieldName)).Visible = True
Loop
Do While Not rstvFalse.EOF
Forms!frmMRecords.tbMRecordSubs.Pages(rstvFalse.Fields(strFieldName)).Visible = False
Loop
End Function
If anyone can help me figure out my stupidity, you deserve an up vote, a check mark, and a cookie.
EDIT again
Below is updated code for the public function. I fixed the rs for the true query, and I added in the MoveNext for the loops.
Public Function ShowRequirements()
Dim db As DAO.Database
Dim strRstVTrue As String
Dim rstvTrue As DAO.Recordset
Dim strRstVFalse As String
Dim rstvFalse As DAO.Recordset
Dim strFieldName As String
'Setup the recordset
Set db = CurrentDb
strRstVTrue = "SELECT tblMRecordRequirements.ID, tblMRecordRequirements.FKMC, tblReqType.txtRequirementPage " & _
"FROM tblMRecordRequirements LEFT JOIN tblReqType ON tblMRecordRequirements.FKRequirementType = tblReqType.ID " & _
"WHERE tblReqType.txtRequirementPage Is Not Null AND tblMRecordRequirements.FKMC = " & Nz(Forms!frmMRecords!ID, 0)
strRstVFalse = "SELECT tblReqType.ID, tblReqType.txtRequirementPage, tblMRecordRequirements.FKMC " & _
"FROM tblReqType LEFT JOIN tblMRecordRequirements ON tblReqType.ID = tblMRecordRequirements.FKRequirementType " & _
"WHERE tblReqType.txtRequirementPage Is Not Null AND tblMRecordRequirements.FKMC <> Is Null"
Set rstvTrue = CurrentDb.OpenRecordset(strRstVTrue, dbOpenDynaset, dbSeeChanges)
Set rstvFalse = CurrentDb.OpenRecordset(strRstVFalse, dbOpenDynaset, dbSeeChanges)
strFieldName = "txtRequirementPage"
Do While Not rstvTrue.EOF
Forms!frmMRecords.tbMRecordSubs.Pages(rstvTrue.Fields(strFieldName)).Visible = True
rstvTrue.MoveNext
Loop
Do While Not rstvFalse.EOF
Forms!frmMRecords.tbMRecordSubs.Pages(rstvFalse.Fields(strFieldName)).Visible = False
rstvFalse.MoveNext
Loop
End Function
EDIT REDUX
I think I may have it worked out, but let me know what you all think. I really appreciate all your thoughts on this, as I know you all have a lot of experience not just in figuring out these kinds of challenges, but ensuring the code is good and not prone to issues.
Here is where I am at:
Public Function ShowRequirements()
Dim db As DAO.Database
Dim db2 As DAO.Database
Dim strRstVTrue As String
Dim rstvTrue As DAO.Recordset
Dim strRstVFalse As String
Dim rstvFalse As DAO.Recordset
Dim strFieldName As String
strFieldName = "txtRequirementPage"
Set db = CurrentDb
Set db2 = CurrentDb
strRstVTrue = "SELECT tblReqType.txtRequirementPage " & _
"FROM tblReqType LEFT JOIN tblMRecordRequirements ON tblMRecordRequirements.FKRequirementType = tblReqType.ID " & _
"WHERE tblReqType.txtRequirementPage Is Not Null AND tblMRecordRequirements.FKMC = " & MCID
strRstVFalse = "SELECT tblReqType.txtRequirementPage " & _
"FROM tblReqType LEFT JOIN tblMRecordRequirements ON tblMRecordRequirements.FKRequirementType = tblReqType.ID " & _
"WHERE tblMRecordRequirements.ID Not In (Select ID From [tblMRecordRequirements] WHERE [tblMRecordRequirements]![FKMC] = " & MCID & _
") AND tblReqType.txtRequirementPage Is Not Null;"
Set rstvTrue = db.OpenRecordset(strRstVTrue, dbOpenDynaset, dbSeeChanges)
Set rstvFalse = db2.OpenRecordset(strRstVFalse, dbOpenDynaset, dbSeeChanges)
Do While Not rstvTrue.EOF
Forms!frmMRecords.tbMRecordSubs.Pages(rstvTrue.Fields(strFieldName)).Visible = True
rstvTrue.MoveNext
Loop
Do While Not rstvFalse.EOF
Forms!frmMRecords.tbMRecordSubs.Pages(rstvFalse.Fields(strFieldName)).Visible = False
rstvFalse.MoveNext
Loop
End Function
I need this code to run anytime the main form is loaded, and the detail is made visible (meaning a main record has been chosen from a find form). Also anytime a requirement record is added.
Put the code you shared inside a sub procedure and call the sub procedure from Form_Load(), Form_Current(), Form_AfterInsert() event handler, etc.
As for elegance, I'd focus on maintainability and efficiency rather than looks, but concise code is also nice. 1) You can use a With block to reduce redundant object method calls, but that'll only work for one reference at a time. 2) Instead create another variable to temporarily hold a value/object from a series of dot property-accessors. 3) It looks like pages and column values are already numbered with a consistent naming pattern, so leverage that in a loop. 4) Comparison operations in VBA are largely Boolean operations, so they return True or False. The result of an entire Boolean expression can be assigned to another Boolean variable/property. (Boolean operations can also return Null... which is usually, but not always, treated like False. If you're certain that your data doesn't have Null values, then you can simplify the code and ignore this issue. If the data can contain null, then you need to adjust the code appropriately.)
Me.Parent!pgReqType1 is calling the default property of the Parent form which is Controls, which default property is Item. The bang operator ! passes the code text as a string into the collection Item method. In short, it is equivalent to Me.Parent.Controls.Item("pgReqType1").
Dim i as integer
Dim ctls as Controls
Dim reqValue as string
Set ctls = Me.Parent.Controls
reqValue = Me.FKRequirementType.Column(1)
For i = 1 to 4
ctls.Item("pgReqType" & i).Visible = (reqValue = "ReqType" & i)
Next i
About all I can do is translate the specific code snippet you show. I have the feeling there is probably more to it than this, because the code snippet you shared ensures that there will only be one tab visible: It is testing the same column value multiple times which could only have one value. Bug? Incomplete example?
This really goes against my better judgement of Stack Overflow principles --to not answer multi-part, continuing debugging questions-- but I really want a cookie.
How could the posted code have ever worked, since you are not moving through either recordset? There are no MoveNext calls. That means that both recordsets are empty or an error is being thrown that is being ignored somewhere (i.e. On Error Resume Next). Otherwise, it should lock up Access with infinite loops. Sometimes you can stop the code with Ctrl+Break, but not always successful in Access.
More precise table schema is required to properly interpret your data, but I'll make some assumptions. You state that tblReqType contains all requirement types. I'll assume that tblMRecordRequirements contains rows only for requirements which are "applied" (a.k.a. "on", "selected") for the ID value in tblMRecordRequirements.FKMC. Assuming the converse, if there are no rows in tblMRecordRequirements with ID in tblMRecordRequirements.FKMC for a given tblMRecordRequirements.FKRequirementType, then the requirement is not "applied" to that ID.
Does every row in tblReqType have a value in txtRequirementPage, or do some rows have null values? Also, can multiple requirements have the same page specified? Or is it a true one-to-one requirement-to-page mapping with no null values?
First of all why would the first query not be an INNER JOIN, since I assume that only records that match in both tables should be returned for the Visible = True condition? Depending on your answers above, this would probably make the condition tblReqType.txtRequirementPage Is Not Null unnecessary in the first query.
Simply reversing a LEFT JOIN will not return what you want especially if you select all other ID values ( tblMRecordRequirements.FKMC <> Nz(Forms!frmMRecords!ID, 0) ). All that does is give you the requirements for every other ID values. Not only will that be inefficient since it could return many, many irrelevant records, it could be likely that over all other ID values that every possible requirement would be applied, so that the second query will essentially cause all requirements to be invisible.
Further picky observations:
If Forms!frmMRecords!ID is null, then you might as well not even execute the queries. You should check that value for null separately and perform appropriate actions rather than letting that specific condition fall through the other code, even if the end side effect is what you desire. It makes the code harder to debug and interpret properly. In other words write code that does "If ID is null, set all pages to visible = false, then exit the sub (i.e. skip other code)"
It's more efficient to get a read-only snapshot rather than an fully-updatable Dynaset recordset: Too much overhead just for looping through without data manipulation.
Proper break points, debug output and error handling code can help identify bad code. It is worth tracing through results of recordsets manually to inspect values and proper SQL syntax.
Try this:
Public Sub ShowRequirements()
Dim db As DAO.Database
Dim iID As Long '? Assuming long integer
Dim strSQL As String
Dim rsTabs As DAO.Recordset
On Error Resume Next
iID = -1 '* Set to bogus value
If Not IsNull(Forms!frmMRecords!ID) Then
iID = Forms!frmMRecords!ID
End If
If iID = -1 Or Err.Number <> 0 Then
'* Problem accessing ID control on form (empty recordset, new record row, etc.)
'* or it is null
'Set all tab pages to Visible = False?
Exit Sub
End If
On Error GoTo Catch
'* Setup the recordset
Set db = CurrentDb
'* Use embedded query (replacable with saved query) for filtering on ID values.
'* This is critical so that the LEFT JOIN does not return or filter records
'* based on other ID values.
strSQL = _
"SELECT tblReqType.ID, tblReqType.txtRequirementPage, (IDReq.FKRequirementType Is Not Null) As ShowTab " & _
" FROM tblReqType LEFT JOIN" & _
" (SELECT MReq.FKRequirementType FROM tblMRecordRequirements AS MReq " & _
" WHERE MReq.FKMC = " & iID & ") AS IDReq" & _
" ON tblReqType.ID = IDReq.FKRequirementType" & _
" WHERE tblReqType.txtRequirementPage Is Not Null"
Set rsTabs = db.OpenRecordset(strRstVTrue, dbOpenSnapshot, dbReadOnly)
Do While Not rsTabs.EOF
Forms!frmMRecords.tbMRecordSubs.Pages(rsTabs!txtRequirementPage).Visible = rsTabs!ShowTab
rsTabs.MoveNext '* Advance recordset. (Avoid infinite loops.)
Loop
CloseAll:
On Error Resume Next
'* Best habit to explicitly close recordsets and database connections, even when not necessary (since they'll close automatically when they go out of scope)
If Not rsTabs Is Nothing Then
rsTabs.Close
Set rsTabs = Nothing
End If
Set db = Nothing
Exit Sub
Catch:
'* At least report error for development
Debug.Print "ShowRequirements(): Error: " & Err.Number & ": " & Err.Description
'* Show MsgBox or update form status control?
'* Set all tab pages to Visible = False?
'* Form state could be misleading without proper user notification and/or error handling
Resume CloseAll
End Sub

Access 2013, Extract number from field to use in search

Have a sales proposal access database for work that has a field that you can put a earlier corresponding proposal number as a reference. If you click on a button under that field it will take you directly to that earlier record. There are times we have a prefix in front of the number A-12345, E-12345 or it might just be 12345.
I need to be able to grab just the number without the letter and - for the search to work correctly. Thanks
Here is the image of my screen
Assuming you have a table with columns Proposal and Reference and a single form with controls txtReference and txtProposal, put this code to the On_Click event of your form button (I'm using DAO):
Dim strProposal As String
Dim i As Integer
Dim rs As DAO.Recordset
If Len(Nz(Me.txtReference, "")) < 1 Then
MsgBox "No reference number entered"
Else
For i = 1 To Len(Me.txtReference)
If IsNumeric(Mid(Me.txtReference, i, 1)) Then
strProposal = strProposal & Mid(Me.txtReference, i, 1)
End If
Next
End If
Set rs = Me.RecordsetClone
rs.MoveFirst
rs.FindFirst "Proposal = '" & StrProposal & "'"
If rs.NoMatch Then
MsgBox "Original proposal not found"
Else
Me.Bookmark = rs.Bookmark
Me.txtProposal.SetFocus
End If
rs.Close
Set rs = Nothing

Warning for Dynamic Combobox list

I have a combobox that builds it's list upon first usage. I know that the way I want "NotInList" to behave isn't conventional - I don't want to waste adding the item to a table separate from the needed entry, but I'd like to still warn about an item that hasn't been used yet, so that the user has to think twice before accepting the entry.
Once the user adds the item, it will automatically appear in the list next time because the data source for the combo box is as follows:
SELECT tbl_SP.PROGRAM
FROM tbl_SP
GROUP BY tbl_SP.PROGRAM
HAVING (((tbl_SP.PROGRAM) Is Not Null And (tbl_SP.PROGRAM)<>""));
I tried this:
Private Sub cmbPROGRAM_NotInList(NewData As String, Response As Integer)
If MsgBox("'" & Chr(34) & NewData & Chr(34) & " hasn't been used yet. Add to list? ", vbQuestion + vbYesNo, "Add - " & NewData & "?") = vbYes Then
Response = acDataErrAdded
End If
End Sub
but of course, Access wants the item to actually exist before it will release the error. And...if I set LimitToList to "No" then the user doesn't get a warning.
How can I achieve this behavior?
Ok, I tried this which works fine if the user selects YES, but becomes more complicated when the user selects "NO"
Public Function ReturnsRecords(strSQL As String) As Boolean
Dim d As DAO.Database
Dim arr(1 To 3) As DAO.Recordset
'Dim rs As DAO.Recordset
'assume 3 items in array above
Set d = CurrentDb
Set arr(1) = d.OpenRecordset(strSQL)
' MsgBox "Record Count is " & arr(1).RecordCount
If arr(1).RecordCount > 0 Then
ReturnsRecords = True
Else
ReturnsRecords = False
End If
Set d = Nothing
End Function
Private Sub cmbPROGRAM_BeforeUpdate(Cancel As Integer)
Dim strSQL As String
strSQL = "Select * from LU_PROGRAM where PROGRAM ='" & Me.cmbPROGRAM & "'"
If ReturnsRecords(strSQL) = False Then
If MsgBox("'" & Chr(34) & Me.cmbPROGRAM & Chr(34) & " hasn't been used yet. Add to list? ", vbQuestion + vbYesNo, "Add - " & Me.cmbPROGRAM & "?") = vbNo Then
Cancel = True
' how do I reset this? Me.cmbPROGRAM.Text = Null
End If
End If
End Sub
How do I clear the combobox if the user selects NO? If I select me.undo, that will undo all of the entries, but I just want to clear the combobox.
Incidentally, the form is totally unbound and doesn't accept an entry until the user selects "Save"
First, I'm not quite sure what you wish to achieve ...
Then, educate the users to press Escape to cancel. This is mandatory wisdom when operating an Access application.
For your code to work, you can't change the content of a control in the BeforeUpdate event. So try the AfterUpdate event with either:
Me!cmbPROGRAM.Text = ""
or:
Me!cmbPROGRAM.Value = Null

How would I make a form which searches for values in all tables of a database in access

I am trying to make a form which searches for the value inside all of the tables in the database (there are more than 1 table). The result will be displayed as the name of the table which this appears in. If someone can help me that will be nice.
In short, I have a form with a textbox and button. I enter the search string (for example 183939) and click on the button. It searches the value (183939) inside all the fields in the tables in the database, and if the value is found, then it displays the name of the table that it appears in. Thanks for the help.
I think this is a bad idea because it could take a very long time, and provide confusing results due to also searching system tables... but the following function will return an array of all table names containing the search term or nothing if it wasn't found. Calling example is such: theTables = containingTable("hello") where theTables is a variant. A limitation is that this will fail for multi-valued fields.
Function containingTables(term As String)
Dim db As Database
Dim tds As TableDefs
Dim td As TableDef
Set db = CurrentDb
Set tds = db.TableDefs
For Each td In tds
For Each f In td.Fields
On Error Resume Next
If DCount("[" & f.Name & "]", "[" & td.Name & "]", "[" & f.Name & "] LIKE '*" & term & "*'") Then
If Err.Number <> 0 Then
Debug.Print Err.Number, Err.Description
Err.Clear
On Error GoTo 0
Else
containingTables = containingTables & td.Name & ","
Exit For
End If
End If
Next
Next
Set tds = Nothing
Set db = Nothing
'Alternate Version
if Len(containgingTables) then containingTables = Left(containingTables, Len(containingTables) - 1)
'Original Version
'if Len(containgingTables) then containingTables = Split(Left(containingTables, Len(containingTables) - 1), ",")
End Function
To display the results with the alternate version, just use: Msgbox(containingTables(searchTerm)) where searchTerm is whatever you are searching.
Me as well i don't know why you would want to do something like that...
I think the solution posted by Daniel Cook is correct, i just took a slightly different approach. Do you need to match the exact value like I do? Anyway, here's my code:
Function searchTables(term as String)
Dim T As TableDef
Dim Rs As Recordset
Dim Result() As String
Dim Counter
Counter = 0
For Each T In CurrentDb.TableDefs
If (Left(T.Name, 4) <> "USys") And (T.Attributes = 0) Then
Set Rs = T.OpenRecordset
While Not Rs.EOF
For Each Field In Rs.Fields
If Rs(Field.Name) = term Then
Counter = Counter + 1
ReDim Preserve Result(Counter)
Result(Counter) = T.Name & "," & Field.Name
End If
Next
Rs.MoveNext
Wend
Rs.Close
End If
Next
If Counter = 0 Then
searchTables = Null
Else
searchTables = Result
End If
End Function
You should filter out duplicated values, in case the function matches multiple times the same filed in the same table.