My goal is to send a query result to each email receipient. The email is in the same query. I am so close on this code but my loop keeps appending the query data in the next email after the first one. Any assistance will be greatly appreciated.
Code:
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim intLastCol As Integer
Dim varItem As Variant
Dim qdef As DAO.QueryDef
Dim i As Integer
Dim strSQL As String
Dim strWhere As String
Dim strIN As String
Dim flgSelectAll As Boolean
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim oItem As Variant
Dim bodytext As String
Dim iCount As Integer
Set db = CurrentDb
'select all employees from query
Set rs = db.OpenRecordset("qryMailMerge", dbOpenSnapshot)
'Create email message and attach data from recordset
Set oLook = CreateObject("Outlook.Application")
Set oMail = oLook.CreateItem(0)
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
'Create body using HTML tags and recordset
With rs
rs.MoveFirst
bodytext = ""
Do While Not rs.EOF
bodytext = bodytext & "<b>" & "Responses for " & rs![_Name] & "</b>" & "<br>" & "<br>"
bodytext = bodytext & "Question 1: Did you have at least one GPS performance Touch Base per month in the last quarter? " & rs![Count_TouchBase_Yes] & " " & "(" & rs![Pct_TouchBase_Yes] & "%) of " & rs![TotalResponses] & " total respondents answered yes." & "<br>" & "<br>"
bodytext = bodytext & "The following answers range from a scale of 1 (Strongly Disagree) to 5 (Strongly Agree)" & "<br>"
bodytext = bodytext & "Question 2: The way my manager provides feedback makes me want to receive feedback more frequently: " & rs![Open_To_MoreFeedback1-5] & "<br>"
bodytext = bodytext & "Question 3: The way my manager provides feedback helps to increase my level of performance: " & rs![Increase_Level_1-5] & "<br>"
bodytext = bodytext & "Question 4: The way my manager provides feedback inspires me to apply what I have learned from my successes and failures: " & rs![Apply_1-5] & "<br>" & "<br>"
bodytext = bodytext & "Comments - the following answers are grouped by respondent and address the following questions" & "<br>"
bodytext = bodytext & "<ul>" & "<li>" & "What is your manager doing well?" & "<br>"
bodytext = bodytext & "<li>" & "Where is your manager getting stuck?" & "<br>"
bodytext = bodytext & "<li>" & "What should your manager do differently next time?" & "<br>" & "<br>"
bodytext = bodytext & rs![Comment01] & "<br>"
bodytext = bodytext & rs![Comment02] & "<br>"
bodytext = bodytext & rs![Comment03] & "<br>"
bodytext = bodytext & rs![Comment04] & "<br>"
bodytext = bodytext & rs![Comment05] & "<br>"
With MailOutLook
.BodyFormat = olFormatHTML
.SentOnBehalfOfName = "Email@Outlook.com"
.To = rs![Supervisor_Email]
.CC = ""
.Subject = "GPS Survey Results"
.HTMLBody = bodytext
.Display (True)
End With
rs.MoveNext
Loop
End With