3
KeyField Full_Name COURSE NPDD CENSUS LDTD Email
jd1001 John Doe ART 001-0101 1/15/2015 2/16/2015 3/17/2015 johndoe@fakeemail.com
jd1001 John Doe ART 023-0202 1/16/2015 2/17/2015 3/18/2015 johndoe@fakeemail.com
my1002 May Yee MATh 115-0303 7/1/2015 8/2/2015 9/3/2015 mayyee@thisemail.com
my1002 May Yee LAW 001-0505 8/1/2015 9/4/2015 10/20/2015 mayyee@thisemail.com
my1002 May Yee LAW 002-0303 9/1/2015 9/9/1015 10/30/2015 mayyee@thisemail.com
So I want to send an email to each instructor with his/her course in the outlook body. Following code result 1 email to the first faculty only with all 5 courses. I understand I need another loop (while keyField) to get it work but I cannot figure this out.Please help me with this outer loop. Thanks.
Expand|Select|Wrap|Line Numbers
- Option Compare Database
- Option Explicit
- Public Function send_mail()
- 'Create application and mail objects
- Dim olApp As Object
- Dim objMail As Object
- Dim rs As DAO.Recordset
- Dim strID As String
- Dim strHeader As String
- Dim strText As String
- Dim strName As String
- Dim strEmail As String
- strText = ""
- Dim qd As QueryDef
- Set qd = CurrentDb.QueryDefs!qryDataToSend
- 'Create a record set and run the query defined above
- Set rs = qd.OpenRecordset()
- If (rs.BOF = True And rs.EOF = True) Then
- 'No record to process, should exit
- Else
- rs.MoveFirst
- End If
- Set olApp = CreateObject("Outlook.Application") 'Create a new instance
- 'Create e-mail item
- Set objMail = olApp.CreateItem(olMailItem)
- 'Email header
- strName = rs!Full_Name
- strEmail = rs!email
- With objMail
- .BodyFormat = olFormatHTML
- .To = strEmail
- .Subject = "Deadline Reminder"
- .HTMLBody = "<!DOCTYPE html>"
- .HTMLBody = .HTMLBody & "<html><head><style>table, th, td {border: 1px solid black}</style><body>"
- .HTMLBody = .HTMLBody & "Dear " & strName & "," & "<p>"
- .HTMLBody = .HTMLBody & "Below are your courses that the NPDD deadline is near."
- .HTMLBody = .HTMLBody & "<table style='width:40%'>"
- .HTMLBody = .HTMLBody & "<tr bgcolor='#AAAAAA'><td>COURSE</td>"
- .HTMLBody = .HTMLBody & "<td align='center'>NPDD</td>"
- .HTMLBody = .HTMLBody & "<td align='center'>CENSUS</td>"
- .HTMLBody = .HTMLBody & "<td align='center'>LDTD</td></tr>"
- End With
- strID = rs!keyfield
- While Not rs.EOF
- 'Add each entry to the body
- With objMail
- .HTMLBody = .HTMLBody & "<tr><td>" & rs!COURSE & "</td>"
- .HTMLBody = .HTMLBody & "<td align='center'>" & rs!NPDD & "</td>"
- .HTMLBody = .HTMLBody & "<td align='center'>" & rs!CENSUS & "</td>"
- .HTMLBody = .HTMLBody & "<td align='center'>" & rs!LDTD & "</td></tr>"
- End With
- rs.MoveNext
- Wend
- 'Add end of the body and send
- With objMail
- .HTMLBody = objMail.HTMLBody & "</Table></Body>" & vbNewLine & "Signature" & vbCrLf & "Company"
- '.send
- .Display
- End With
- Set olApp = Nothing
- Set objMail = Nothing
- End Function
