It seems this problem should have a rather simplistic solution. When trying to run the dlookup for ID, I return a null value when using the RequestNum string. RequestNum is simply an AutoNumber. RequestNum does write to the popup form that is opening up on its own. Also, if i replace RequestNum with the actual number in the field I get the desired returned result. The only help I've been able to find online is that most people did not use '" & stringhere & "' though I obviously am. Any ideas? I'll be happy to supply any additional details if needed. Thanks in advance!
Private Sub lst_AdminDate1_DblClick(Cancel As Integer)
Dim IDx As String
Dim RequestNum As String
DoCmd.OpenForm "Administrative_LeaveCalendar_Detail"
RequestNum = Me.lst_AdminDate1.Column(2)
IDx = DLookup("[ID]", "TimeOffCalendar", "[RequestNumber] = '" & RequestNum & "'")
[Forms]![Administrative_LeaveCalendar_Detail]![txtAdminDateDetail_RN] = RequestNum
[Forms]![Administrative_LeaveCalendar_Detail]![txtAdminDateDetail_ID] = IDx
End Sub
What may confuse you is, that a listbox always returns strings even if the value was a number and is supposed to be used as such. Also, DLookup may return Null.
Thus, if [RequestNumber] is a Long (which is should be):
Private Sub lst_AdminDate1_DblClick(Cancel As Integer)
Dim IDx As Variant
Dim RequestNum As String
DoCmd.OpenForm "Administrative_LeaveCalendar_Detail"
RequestNum = Me.lst_AdminDate1.Column(2)
IDx = DLookup("[ID]", "TimeOffCalendar", "[RequestNumber] = " & RequestNum & "")
[Forms]![Administrative_LeaveCalendar_Detail]![txtAdminDateDetail_RN] = RequestNum
[Forms]![Administrative_LeaveCalendar_Detail]![txtAdminDateDetail_ID] = IDx
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.
I have a form which has many controls on it. I would like to create custom filter that allows the user to search for any record on the form using any filed value as search criteria.
For example: The user can search record using id or the can search using Grade, etc.
I have wriiten the follwing code for now :
Private Sub CmdFind_Click()
Dim filterStr As String
Dim strWhere As String
filterStr = InputBox("Enter your filter criteria")
strWhere = "[SalesOrderNumber] = '" & filterStr & "' "
Me.Filter = strWhere
Me.FilterOn = True
End Sub
However, this searches only for 'SalesOrderNumber'. I want the functionality to search using other values as well.
Any help would be appreciated. Thankyou
As can I understand. You want to search for multiple fields.
In that case you may use OR clause:
Private Sub CmdFind_Click()
Dim filterStr As String
filterStr = InputBox("Enter your filter criteria")
Dim filters(0 To 2) As String
filters(0) = BuildCriteria("SalesOrderNumber", dbText, filterStr)
filters(1) = BuildCriteria("UserPhoneNumber", dbText, filterStr)
filters(2) = BuildCriteria("Comments", dbText, filterStr)
Me.Filter = Join(filters, " OR ")
Me.FilterOn = True
End Sub
I have a table Contacts in Access and a search form. After the user specifies the search criteria, the table only shows records that meet the criteria
Is their a way to retrieve all email addresses of searched contacts as semi-colon separated list so that i can just copy and paste in new email's To field.
Any help is appreciated
Roshan.
You might as well make use of an UDF, just keeping it out of the procedure. Get the criteria by which you filter the result. Then you simply pass the criteria. I am not sure how you have built your criteria. A stab in the dark is get all email of people named "Paul". So your code will be.
Public Sub getEmailString(FieldName As String, Tablename As String, Criteria As String)
Dim tmpRS As DAO.Recordset
Dim tmpStr As String, retStr As String
tmpStr = "SELECT " & FieldName & " FROM " & Tablename & " WHERE " & Criteria
Set tmpRS = CurrentDB.OpenRecordset(tmpStr)
If tmpRS.RecordCount > 0 Then
Do While Not tmpRS.EOF
retStr = retStr & tmpRS.Fields(0) & ";"
tmpRS.MoveNext
Loop
End If
getEmailString = retStr
Set tmpRS = Nothing
End Sub
To use it, you simply use.
Dim someEmailString As String
someEmailString = getEmailString("EmailFieldName", "ContactsTableName", "FirstName = 'Paul'")
If you have something it should return,
paul.someone#somedomain.com;paul.someoneelse#somenewdomain.co.uk;
Hope this helps.
I am getting this error with one of my tables in a database:
(An exception of type System.Data.OleDb.OleDbException occurred in System.Data.dll but was not handled in user code
Additional information: Syntax error in UPDATE statement.)
It allows me to read from it but when I come to add a new record or update it using an SQL query it gives me this error, I have checked, double checked and triple checked but can't see anything wrong with it...strange thing is is I took it from another table which I know was working and made sure I changed all the variables but to no avail!
Apologies if you all think this is very dirty code, its my first year project and I'm still getting my head round quicker ways to do things!
If anyone could have a look at it and see if they can figure it out, it would be much appreciated!
Sub Update()
Dim cs As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Server.MapPath("mydatabasename") + ";"
Dim cn As New OleDbConnection(cs)
Dim cmd As OleDbCommand
Dim r As OleDbDataReader
Dim ite As String
Dim siz As String
Dim quantit As String
Dim pric As String
Dim sourc As String
Dim updatestockstrings As String
updatestockstrings = Request.QueryString("updatestock")
ite = itm.Value
siz = sze.Value
quantit = qty.Value
pric = prc.Value
sourc = imgsrc.Value
If ite = "" Then
parMsg.InnerHtml = "Please add an item name"
ElseIf siz = "" Then
parMsg.InnerHtml = "Please add a size"
ElseIf quantit = "" Then
parMsg.InnerHtml = "Please add a quantity"
ElseIf pric = "" Then
parMsg.InnerHtml = "Please state a price"
ElseIf sourc = "" Then
parMsg.InnerHtml = "Please add an image source"
Else
cmd = New OleDbCommand("UPDATE Stocks Set Item='" & ite & "', Size='" & siz & "', Quantity='" & quantit & "', Price='" & pric & "', ImageSource='" & sourc & "' WHERE StockID=" & updatestockstrings & ";", cn)
cn.Open()
r = cmd.ExecuteReader()
Do While r.Read()
Loop
cn.Close()
parMsg.InnerHtml = "Update Successful!"
End If
End Sub
SIZE is a reserved word in MS-Access, you need to put square brackets around it
[SIZE]=......
But I really suggest to use a parameterized query to defend yourself from SQL Injection and parsing problems (What happens if one or more of your input strings contains a single quote?)
cmd = New OleDbCommand("UPDATE Stocks Set Item=?, [Size]=?, Quantity=?, " & _
"Price=?, ImageSource=? WHERE StockID=?", cn)
cmd.Parameters.AddWithValue("#p1", item)
cmd.Parameters.AddWithValue("#p2", siz)
cmd.Parameters.AddWithValue("#p3", quantit )
cmd.Parameters.AddWithValue("#p4", pric)
cmd.Parameters.AddWithValue("#p5", sourc)
cmd.Parameters.AddWithValue("#p6", updatestockstrings)
But this is still not enough. You should pass parameters with the correct datatype for the underlying database field. So, for example, if the database field Price is a decimal column then you need to convert the pric variable to a decimal value (and this requires that you parse it to be sure that you have received a valid decimal value)
In extension to #Steve's answer, on your posting,
You have to use ExecuteNonQuery on statements like INSERT, UPDATE, and DELETE. It returns the number of records affected but not a ResultSet to read records from.
ExecuteReader is for SELECT statements that returns a set of records to read.
Change:
cn.Open()
r = cmd.ExecuteReader()
Do While r.Read()
Loop
cn.Close()
To:
cn.Open()
cmd.ExecuteNonQuery()
cn.Close()
Unless required, capturing the result of ExecuteNonQuery into an integer is optional.
Hello Fellow programmers,
I am absolutely desperate as I can not figure out how to solve (maybe) simple problem. I have two tables. First one [Files] with two fields: [FName](file name) and [FPath](file path) and second one [Reports] with [DocNo] [Title]...blah blah...
FName string consists of [DocNo] [Title](but the whole title string is not as a file path)
Example:
[DocNo] Smith/RT/2000/001
[Title] Assessment of modified aluminothermic welds in 68kg/m head hardened rail for BHP Iron Ore Pty Ltd
[FName] SmithRT2000001 Assessment of modified aluminothermic welds .pdf
I have a form which has a search list on it. this list brings up records which are in [Reports]. By double clicking on a specific record, it fires up doubleclick event. in the Event I get the value of DocNo and Title and search into Files table for the Fname to match. But surprisingly it doesn't return anything when I put the sql search or even in the design mode for query?
BUT the funny thing is that when I hard code to find the record, both of ways will find it. how is that?
Here is the VBA to check out:
Private Sub SearchResults_DblClick(Cancel As Integer)
'Initializing the string variables
Dim strSQL As String
Dim strFileName As String
Dim strTitle As String
Dim DocumentNo As String
Dim titleLeng As Integer
DocumentNo = Me.SearchResults.Column(0)
DocumentNo = Replace(DocumentNo, "/", "")
strTitle = Me.SearchResults.Column(1)
Debug.Print (DocumentNo)
SrchText = DocumentNo
SearchResults.RowSourceType = "Table/Query"
SearchResults.RowSource = "QRY_OpenFile"
Debug.Print (strTitle)
strTitle = Left(strTitle, 10)
SrchText = strTitle
Debug.Print (SrchText)
SearchResults.RowSource = "QRY_OpenFile"
Dim rst As Recordset
Dim db As DAO.Database
Set db = CurrentDb()
strSQL = "SELECT Files.FName FROM Files WHERE Files.FName Like " * " & strTitle & " * ";"
Debug.Print (strSQL)
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
Application.FollowHyperlink strFileName, , True, False, , , "John Smith"
I have tried every variation in SQL string, changing outer " " to ' ' does not work. But if I change strTitle with "Assessment" string or "SmithRT2000001" it will finds it. DO not know why?
This does not work in the query design window where you put criteria:
Like "* & Forms![Search For Reports]![SrchText] & *"
But as soon as I change it something static it will work. Going crazy!!
Can you guide me as what to do or how to achieve my goal which is opening the file in FILE table??
Okay, After testing 3 different approaches at the end one of them gave a good response and what I wanted. I changed the "like" command in my query to:
Like "*" & [Forms]![Search For Reports]![SrchText] & "*"
and suddenly it worked. Also I found out that SQL Select query doesn't work from VBA specially with Double click event.
Here is the final code:
Private Sub SearchResults_DblClick(Cancel As Integer)
'Initializing the string variables
Dim strTitle As String
Dim DocumentNo As String
DocumentNo = Me.SearchResults.Column(0)
DocumentNo = Replace(DocumentNo, "/", "")
strTitle = Me.SearchResults.Column(1)
strTitle = Replace(strTitle, "'", "''")
SrchText.Value = DocumentNo
SearchResults.RowSourceType = "Table/Query"
SearchResults.RowSource = "QRY_OpenFile"
End Sub
I could not get the path and name from the list, to put them together and fire up a hyperlink to Acrobat...What I had to do was sending an event via a button to get the values from the list. For some reason after SearchResults.RowSource = "QRY_OpenFile" the list.Column(index) was returning null.
Anyway thanks for reading my question and thinking about it.
Did that code actually run? You have the SQL string in a tangle:
''You need to watch out for quotes in the string, so
strTitle = Replace(strtile, "'", "''")
strSQL = "SELECT Files.FName FROM Files WHERE Files.FName Like '*" _
& strTitle & "*';"
The point of this line:
Debug.Print (strSQL)
Is to get an SQL string to test in the query design window. Use it.