Forum Discussion
Solved
Help with Access VBA code to automate email!!!!!
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
I 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
5 Replies
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).
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?
I 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
