Send current record to Outlook

[imperator]

Hi All

Below is a click event which sends the data in a query to Outlook and emails it. It works a charm though I'm sure it lacks programming finesse as I am a novice, but books and the web have got me this far.

My question is this: the click event is on a form showing one record, how can I get this code to send the current record to email? At the moment it just sends the first.

Please excuse all the strMessage variables but I've structured the code to mimic the structure of the email for ease of viewing.

The query ID field is called Bookings_ID and the textbox on the form is called txtBooksing_ID. If I was sending this to a report then I probably could achieve this but as it is going straight into an email I'm stumped.


Private Sub cmdSendEmail_Click()
On Error GoTo Err_cmdSendEmail_Click
Dim db As Database

Dim recBookingQry As Recordset

Dim objOutlook As New Outlook.Application
Dim objMessage As MailItem
Dim strMessage As String
Dim strSQL As String
Dim datNow As Date

Set db = CurrentDb()
Set recBookingQry = db.OpenRecordset("qryLearningBookingEmail")
datNow = Date

strMessage = "Dear " & recBookingQry("ContactName") & vbCrLf & vbCrLf

strMessage = strMessage + "Following our recent correspondence, I am pleased to email to confirm the " & _
"following details for your booking:" & vbCrLf & vbCrLf

strMessage = strMessage + "Name of venue:" & vbTab & vbTab & recBookingQry("Venue") & vbCrLf
strMessage = strMessage + "Workshop: " & vbTab & vbTab & recBookingQry("Workshop") & vbCrLf
strMessage = strMessage + "Charge: " & vbTab & vbTab & Format(recBookingQry("Charge"), "currency") & vbCrLf
strMessage = strMessage + "Date of visit:" & vbTab & vbTab & Format(recBookingQry("BookingDate"), "Long date") & vbCrLf
strMessage = strMessage + "Name of school:" & vbTab & vbTab & recBookingQry("InstitutionName") & vbCrLf
strMessage = strMessage + "Contact name: " & vbTab & vbTab & recBookingQry("ContactName") & vbCrLf
strMessage = strMessage + "Arrival: " & vbTab & vbTab & Format(recBookingQry("ArrivalTime"), "medium time") & vbCrLf
strMessage = strMessage + "Lunch space: " & vbTab & vbTab & recBookingQry("LunchSpace") & vbCrLf
strMessage = strMessage + "Departure: " & vbTab & vbTab & Format(recBookingQry("DepartureTime"), "medium time") & vbCrLf
strMessage = strMessage + "Additional notes:" & vbTab & vbTab & recBookingQry("AdditionalNotes") & vbCrLf & vbCrLf

strMessage = strMessage + "Please check the above details carefully. If you wish to make any amends please contact (0191) " & _
recBookingQry("VenueTel") & " or email " & recBookingQry("OfficerEmail") & " immediately." & _
vbCrLf & vbCrLf

strMessage = strMessage + "This company expect all workshops and sessions to be paid for in advance. " & _
"You can pay in two ways either by invoice or through a Newcastle Journal request. " & _
"Details of how to do this are explained fully on the attached terms and conditions document." & _
vbCrLf & vbCrLf
strMessage = strMessage + "Please read the Terms and Conditions carefully. If you fully understand and agree " & _
"to all of the conditions and wish to confirm your booking please reply to this email, with your completed " & _
"confirmation form, by " & Format(DateAdd("d", 5, datNow), "Long Date") & ". If you fail to do this your slot will be released to allow " & _
"another group to book." & vbCrLf & vbCrLf & "If you have any further questions please do not hesitate in contacting us." & _
vbCrLf & vbCrLf & "We look forward to welcoming you on your visit." & vbCrLf & vbCrLf & "Regards," & vbCrLf & vbCrLf & "The Learning Team"


If Not IsNull(recBookingQry("ContactEmail")) Then
Set objMessage = objOutlook.CreateItem(olMailItem)
With objMessage
.To = recBookingQry("ContactEmail")
.Subject = "Your booking confirmation"
.Body = strMessage
.Importance = olImportanceHigh
.Send

End With

End If

Exit_cmdSendEmail_Click:
Exit Sub
Err_cmdSendEmail_Click:
MsgBox Err.Description
Resume Exit_cmdSendEmail_Click

End Sub

Thanks in advance,
Ray

 

[imperator]

Can someone please look at this problem and suggest a solution? I would greatly appreciate it. I only need a bit of code to select the current record on the form with the 'send email confirmation' button.
Cheers

 

[JANR]

Do you have a Where-Clause in your qryLearningBookingEmail to limit the records to 1?

If not then you can either put this in the criteriarow of Bookings_ID:

Forms!NameOfYourForm!txtBooksing_ID

or use a select statement when you open your recordset:

Set recBookingQry = db.OpenRecordset("Select * From qryLearningBookingEmail Where Bookings_ID =" & Me.txtBooksing_ID)

Asuming that txtBooking_ID is a number and not text.

txtBooksing_ID ---> is this a typo??

JR

 

[imperator]

Thanks for the reply JANR.

I had just figured out I hadn't put a where clause in the query just before you replied.

I applied your suggestions and got a "Too few parameters. Expected 2" message.

I made the following changes (in red):

Private Sub cmdSendEmail_Click()
On Error GoTo Err_cmdSendEmail_Click
Me.Refresh

Dim db As Database

Dim recBookingQry As Recordset

Dim objOutlook As New Outlook.Application
Dim objMessage As MailItem
Dim strMessage As String
Dim strSQL As String
Dim datNow As Date
Dim qEmail As QueryDef

Set db = CurrentDb()

Set qEmail = db.QueryDefs("qryLearningBookingEmail")

qEmail![Forms!frmLearning!txtBookings_ID] = Me![txtBookings_ID]

Set recBookingQry = db.OpenRecordset("qryLearningBookingEmail")
datNow = Date

etc. etc. (as before)

and now get a "Too few parameters. Expected 1" message. Now, I only have 1 parameter so I assume "qEmail![Forms!frmLearning!txtBookings_ID] = Me![txtBookings_ID]" isn't working.

Any ideas what's going on now?

You are correct about the typo

 

[JANR]

No need to use querydef and modify the query. Just open your query in designmode and in the criteria row for Booking_ID simply put:

Forms!NameOfForm!txtBooking_ID

Since your form will be open when your code runs the query will put in the current booking_ID in the where-clause and limit the recordselection to 1 to send to outlook.

Just make sure that the boldpart is the name of your form.

JR

 

[imperator]

Hi JANR

Just tried that, I removed the querydef, and get the message "Too few parameters. Expected 2."

The code now appears thus:

Private Sub cmdSendEmail_Click()
On Error GoTo Err_cmdSendEmail_Click
Me.Refresh

Dim db As Database

Dim recBookingQry As Recordset

Dim objOutlook As New Outlook.Application
Dim objMessage As MailItem
Dim strMessage As String
Dim strSQL As String
Dim datNow As Date

Set db = CurrentDb()

Set recBookingQry = db.OpenRecordset("Select * From qryLearningBookingEmail Where Bookings_ID =" & Me.txtBookings_ID)

[so on and so forth...]

the query works when I run it after going to a record on the form so that part is fine but it seems the vba can't see the criteria. At least that's how it seems to me.

 

[JANR]

Ok so you go for the alternative.

Question is Bookings_ID text or number?

Does your query now have a criteria?, if it does then remove it.

Can you post a stipped down version of your db with only the relevant form, query and tables with some bogus data in them?

JR

 

[imperator]

Hi JANR

Bookings_ID is a number field (autonumber, primary key)

In the query the Bookings_ID field had the criteria [forms]![frmLearning]![txtBookings_ID]

I've removed it as you asked and the click event sent an email BUT it will only send the last record, not the current. This is different behaviour than before, when it would only send the first record.

I will strip down the db to the essentials of this problem and post it.

Thanks for your help.

 

[imperator]

Hi JANR

Here is the database. I hope you can solved this one for me.
Edit - go to forms and open frmLearning, you will see the button to send the email.
I've just tried to use it and my pc froze up, so I may have missed something in this version. I'll review it to see what's up.

Thank you.

 

[JANR]

I can't test the full code since I don't have outlook installed, but in your query qryLearningBookingEmail the field Booking_ID was missing so you get the too few parameters error.

Second you had put in a string variable strSQL BUT you did not use it:

....
Set db = CurrentDb()
 strSQL = "Select * From qryLearningBookingEmail Where Bookings_ID =" & Forms!frmLearning!txtBookings_ID       
Set recBookingQry = db.OpenRecordset(strSQL)
....

Try this with the Bookings_ID put back into your query without any criteria.

JR

 

[JANR]

BTW in your query you don't have destinct records so you can multiple records for some of your bookings.

I suggest that you remome fields your don't need and from your code it looks like you do not use 2 of them

- YearGroup
- Number <- which is not a good fieldname in access, Reserved word.

JR

 

[imperator]

Hi JANR

You solved it. Many thanks.

The Bookings_ID field vanished from the query when I removed the criteria as it was a Where clause, I didn't notice before I post the DB.

I take your point about the non-distinct records but those fields have to stay in because it forms part of my next task, i.e. to list the year groups and number of pupils in the email so to give the composition of the group.

The unused strSQL was a hangover from something I was trying from a Wrox book, I hadn't removed it when I tried something else. But you put it to good use and solve the problem. Great.

I'm posting the code again as an example for others to use. I hope others find in useful

Private Sub cmdSendEmail_Click()
On Error GoTo Err_cmdSendEmail_Click

'Refresh if necessary
Me.Refresh

Dim db As Database

Dim RECORDSETNAME As Recordset

Dim objOutlook As New Outlook.Application
Dim objMessage As MailItem
Dim strMessage As String
Dim strSQL As String

Set db = CurrentDb()

strSQL = "Select * From YOURQUERYNAME Where FIELDNAME = " & Forms!YOURFORMNAME!CONTROLNAME
​

Set RECORDSETNAME = db.OpenRecordset(strSQL)

'Create the message body

strMessage = "Dear " & RECORDSETNAME("ContactName") & vbCrLf & vbCrLf

strMessage = strMessage + "YOUR MESSAGE HERE." & _
vbCrLf & vbCrLf & "Regards," & vbCrLf & vbCrLf & "SIGNATURE HERE"


If Not IsNull(RECORDSETNAME("ContactEmailAddress")) Then
Set objMessage = objOutlook.CreateItem(olMailItem)
With objMessage
.To = RECORDSETNAME("ContactEmailAddress")
.Subject = "YOUR SUBJECT HERE"
.Body = strMessage
.Importance = olImportanceHigh
.Send

End With

End If

Exit_cmdSendEmail_Click:
Exit Sub
Err_cmdSendEmail_Click:
MsgBox Err.Description
Resume Exit_cmdSendEmail_Click

End Sub

Best wishes,
Ray

 

[JANR]

Great job, but a little housecleaning woulden't hurt

.....
If Not IsNull([COLOR=#ff0000]RECORDSETNAME[/COLOR]("ContactEmailAddress")) Then
Set objMessage = objOutlook.CreateItem(olMailItem)
With objMessage
.To = [COLOR=#ff0000]RECORDSETNAME[/COLOR]("ContactEmailAddress")
.Subject = "[COLOR=red]YOUR SUBJECT HERE[/COLOR]"
.Body = strMessage
.Importance = olImportanceHigh
.Send
[COLOR=red].close[/COLOR]
End With

End If

Exit_cmdSendEmail_Click:
[COLOR=red]Set Recordsetname = Nothing[/COLOR]
[COLOR=#ff0000]Set objMessage = Nothing[/COLOR]
[COLOR=#ff0000]Set objOutlook = Nothing[/COLOR]
Exit Sub

Err_cmdSendEmail_Click:
MsgBox Err.Description
Resume Exit_cmdSendEmail_Click

End Sub

JR