Aug 29 2022 02:04 AM
I am trying to automate sending emails upon opening a Main Menu form based off of records in another query. Then having a check box turn on once the email has been sent so it won't be sent again.
Below I will copy my code but Im getting different errors when I run it and cant seem to get it work. I am very new to coding so if you could point out where I am going wrong and how to fix it with code that would be awesome as I am now pulling my hair out. The current error I am getting is a compile error: Do without Loop.
Here is my code:
Private Sub Form_Open(Cancel As Integer)
'DEFINING RECORDSET TO USE
Dim db As Database
Dim rec As Recordset
Set db = CurrentDb
Set rec = db.OpenRecordset("SELECT * From AllActiveLicenceExpiryDueIn30DaysQ")
If rec.RecordCount > 0 Then
rec.MoveFirst
Do Until rec.EOF
If IsNull(rec!AssignedToEmail) Then
If rec30DaysEmailSent = True Then
rec.MoveNext
'SEND EMAIL REMINDER FOR LICENCE EXPIRY IN 30 DAYS
Dim O As Outlook.Application
Dim M As Outlook.MailItem
Set O = New Outlook.Application
Set M = O.CreateItem(olMailItem)
With M
.BodyFormat = olFormatHTML
.HTMLBody = "Please be aware that " & FirstName & LastName & " Licence is Due for renewal in the next 30 days. Licence Expiry is -" & LicenceExpiry & ",<P>" & _
"Please update New Licence Expiry date and upload copy of New Drivers Licence" & ",<P>" & _
"Kind Regards" & ",<P>" & _
"Kym Wilson"
.To = AssignedToEmployeeEmail
.CC = PersonalEmail
.Subject = "Licence Expiry Due in 30 Days " & Now()
.Display
End With
Set M = Nothing
Set O = Nothing
rec.Edit
rec30DaysEmailSent = True
rec.Update
rec.MoveNext
End If
End If
End Sub
Aug 29 2022 03:55 AM - edited Aug 30 2022 09:08 AM
It is hard to tell without knowing the error messages.
I see at least two main points.
If you refer to fields in a recordset you do it like this:
.To = rec!AssignedToEmployeeEmail. Only in one line you do it right.
A Do Until should always be accompanied by a Loop (in this case before the End Sub).
A thing that does not cause an error but is wrong any way, is where you decide to send an email or not. If AssignedToEmail is NOT Null, you don't look at the DaysEmailSent any more. So you will always send an email.
Edit: there is more wrong with the if's. As there is no Else, the code will continue after the Movenext. So for the next record (even If there is no next) you are going to send an email (without looking to).
Aug 29 2022 05:14 PM
Thanks for that you make some really good points and have clarified some things for me but I now have more questions.
The error that I was getting was a compile error : about needing a Loop which you also state . However now that I have made the changes you have suggested excluding the bit about Else because of the If's (Im still trying to work this out) Do you any links that explains how these work or give me an example of this as I am very confused on what I have read.
Im now got a bigger problem because when I go to open the MainMenu nothing will load just keeps going access not responding. I have tried this on a couple of backup test database and it happens on all on them. Is this because I haven't sorted the Else bit of the code?
My new code is
Private Sub Form_Open(Cancel As Integer)
'DEFINING RECORDSET TO USE
Dim db As Database
Dim rec As Recordset
Set db = CurrentDb
Set rec = db.OpenRecordset("SELECT * From AllActiveLicenceExpiryDueIn30DaysQ")
If rec.RecordCount > 0 Then
rec.MoveFirst
Do Until rec.EOF
If rec!EmailSent30days = True Then
rec.MoveNext
'SEND EMAIL REMINDER FOR LICENCE EXPIRY IN 30 DAYS
Dim O As Outlook.Application
Dim M As Outlook.MailItem
Set O = New Outlook.Application
Set M = O.CreateItem(olMailItem)
With M
.BodyFormat = olFormatHTML
.HTMLBody = "Please be aware that " & FirstName & LastName & " Licence is Due for renewal in the next 30 days. Licence Expiry is -" & LicenceExpiry & ",<P>" & _
"Please update New Licence Expiry date and upload copy of New Drivers Licence" & ",<P>" & _
"Kind Regards" & ",<P>" & _
"Kym Wilson"
.To = rec!AssignedToEmployeeEmail
.CC = rec!PersonalEmail
.Subject = "Licence Expiry Due in 30 Days " & Now()
.Display
End With
rec.Edit
rec!EmailSent30days = True
rec.Update
rec.MoveNext
End If
Loop
End If
End Sub
Also just in regards to the Do until and Loop code is that all I need to do I cant seem to find good examples to help explain it for me?
Aug 30 2022 07:44 AM - edited Aug 30 2022 08:14 AM
SolutionI have made a new setup for your code. It only shows the main structure. You have to insert the code for actually sending an email.
Private Sub Form_Open(Cancel As Integer)
Dim rec As Recordset
Set rec = CurrentDb.OpenRecordset("SELECT * FROM AllActiveLicenceExpiryDueIn30DaysQ")
Do Until rec.EOF
If Not IsNull(rec!AssignedToEmail) And _
Not rec!EmailSent30days Then
'SEND EMAIL REMINDER FOR LICENCE EXPIRY IN 30 DAYS
rec.Edit
rec!EmailSent30days = True
rec.Update
End If
rec.MoveNext
Loop
End Sub
Aug 30 2022 05:33 PM
Thank you so much this has worked !!!!
Although I am going to one more question of you. Now that this works am I able to do this for multiple recordset.
e.g. we currently only have this working for "AllActiveLicenceExpiryDueIn30DaysQ" what if we need to do it for "AllActiveLicenceExpiryOverdueQ" as well. Or for reminders when vehicle inspections are due ( this requires a different email to be sent (I'm all over the programming of the send email part so dont need help with this) I just dont quiet understand the mechanics behind recordsets on how to define multiple queries. Can you point me in the right direction or provide useful records?
Thanks again for the help!!
Aug 31 2022 03:08 AM
Aug 30 2022 07:44 AM - edited Aug 30 2022 08:14 AM
SolutionI have made a new setup for your code. It only shows the main structure. You have to insert the code for actually sending an email.
Private Sub Form_Open(Cancel As Integer)
Dim rec As Recordset
Set rec = CurrentDb.OpenRecordset("SELECT * FROM AllActiveLicenceExpiryDueIn30DaysQ")
Do Until rec.EOF
If Not IsNull(rec!AssignedToEmail) And _
Not rec!EmailSent30days Then
'SEND EMAIL REMINDER FOR LICENCE EXPIRY IN 30 DAYS
rec.Edit
rec!EmailSent30days = True
rec.Update
End If
rec.MoveNext
Loop
End Sub