Making automatic email reminder using VBA - vba

Question

I am trying to make email using Outlook to remind someone to update their CV information per 6 months (180 days).
I have 1 query and 1 table.
Duedate_7 query consists of employee information, which passed 180 days or more since the last update. Access would send email to those employees.
Highlights table consists of the ID of the employees (Number), date of the project (date) and content of the project (long text).
Option Compare Database
Option Explicit
Function Otomail()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim emailTo As String
Dim emailSubject As String
Dim emailText As String
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim outlookStarted As Boolean
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
Set outApp = CreateObject("Outlook.Application")
outlookStarted = True
End If
Set db = CurrentDb
Set rs1 = db.OpenRecordset("SELECT ID, NIK, Nama, email, datemailsend FROM DueDate_7")
Do Until rs1.EOF
emailTo = rs1.Fields("email")
emailSubject = "Update CV"
emailText = "Please send the newest project highlights informations of Mr/Mrs' " & rs1.Fields("Nama").Value & " to the inside sales department for updating your CV which is scheduled once per 6 months." & vbCr & _
"Your latest project highlights update was " & vbCr & _
"This email is auto generated from Task Database. Please Do Not Reply!"
Set outMail = outApp.CreateItem(olMailItem)
outMail.To = emailTo
outMail.Subject = emailSubject
outMail.Body = emailText
outMail.Display
rs1.Edit
rs1!datemailsend = Date
rs1.Update
rs1.MoveNext
Loop
rs1.Close
Set rs1 = Nothing
Set db = Nothing
Set outMail = Nothing
Set outApp = Nothing
End Function
I want to include each of the employee's 3 latest project highlights, stored in Highlights table, in each of the email I send.

Answer 1

What you need to do is to use a second recordset inside the loop that you have already got that selects the information required. Something like:
If Not (rs1.BOF And rs1.EOF) Then
Do
strProject = ""
strSQL = "SELECT TOP 3 ProjectName, ProjectDate " _
& " FROM Highlights " _
& " WHERE NameID=" & rs1!NameID _
& " ORDER BY ProjectDate DESC;"
Set rsProject = db.OpenRecordset(strSQL)
If Not (rsProject.BOF And rsProject.EOF) Then
Do
strProject = strProject & rsProject!ProjectDate & vbTab & rsProject!ProjectName & vbCrLf
rsProject.MoveNext
Loop Until rsProject.EOF
End If
Set outMail = outApp.CreateItem(olMailItem)
outMail.To = rs1!email
outMail.Subject = "Update CV"
outMail.Body = emailText & strProject
outMail.Display
rs1.MoveNext
Loop Until rs1.EOF
End If
This is assuming that you have a field called NameID that identifies the person to be selected.
Regards,