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
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.
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
I have a form with two comboboxes, the first (cboSet) picks a class set, the second (cboName) displays student names within that set (the ID is hidden in the 1st column). I have a button which I would like to use to find the next student in that set. I have tried implementing a next button which will go to the next record but not the correct student. Any help would be much appreciated.
When you say next student, do you mean the student with the next numerical ID or are you using some other criteria for the next student?
here's one possible solution assuming that you want to filter your form with the next student. Without more details this example is somewhat vague. Seeing what you already have would make it more precise.
in the onclick event of your button:
Dim ID as Integer
ID = me.cboName.column(0) + 1
me.filter = "[ID] = " & ID
me.filteron = true
to find the next value in your set you could do something like the following, Of course this is only generic, basic (hopefully someone correct) code, so you'll have to change it to suit your needs, but it should point you in the correct direction.
dim db as dao.database
dim rs as dao.recordset
dim nextID as interger
dim SQLquery as string
nextID = 0
SQLquery = "SELECT TOP 1 ID from COMBO_RECORD_SOURCE WHERE ID > " & me.namecombo.column(0) & " ORDER BY ID"
set db = currentdb
set rs = db.openrecordset(SQLquery,dbOpenSnapshot)
if rs.recordCount > 0 THEN
rs.movefirst //I know it's not strictly necessary, old habit I like to do..
nextID = rs!ID
end if
if nextID > 0 then
me.filter = "[ID] = " & nextID
me.filteron = true
else
msgbox "There are no more names in this set."
end if
set rs = nothing
set db = nothing
I am creating a recordset from a Qdefs and then displaying the records in a form.
When I filter the values, focus is going to the first record. But, I want the focus to point to the same record that was in focus before filtering.
This is how am creating a recordset from an existing querydefs before and after filtering
db.QueryDefs("Query_vinod").Sql = filter
Set rs_Filter_Rowsource = db.OpenRecordset("Abfr_SSCI_Check_Findings_List")
I think you can do this by using a bookmark. Set up a RecordsetClone and then find your active record by using the FindFirst method. I have some sample code that will need to be modified a little to fit your exact variables:
Dim Rs As Recordset
Dim Test As Integer
Dim varBookmark As Variant
DoCmd.OpenForm "Contracts"
Set Rs = Forms!Contracts.RecordsetClone
Rs.FindFirst ("[ID] = '" & Me![ID] & "'")
varBookmark = Rs.Bookmark
Forms!Contracts.Form.Bookmark = varBookmark
If Rs.NoMatch Then
MsgBox "That does not exist in this database."
Else
End If
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.