I am trying to send email records from a query called “Deprog3” to multiple different recipients. The button on the form needs to loop through each record in the form and send an email to the recipient (‘Me.EMAIL’). The email it sends should select all of the records from the “Deprog3” query that relate to that particular individual.
What actually happens though is that it sends just the records specific to the first individual on the first email, then it sends the records from the first AND second individuals on the second email and so on until the last email contains every record from the query.
If I comment out the second line (‘Do While Me.Current Record…’) and the second from last line (‘Loop’), it takes out the looping and means I have to keep clicking ‘Send’, but it doesn’t send the records from the previous individuals.
Any guidance would be greatly appreciated!
Private Sub Send_Click() Do While Me.CurrentRecord < Me.Recordset.RecordCount DoCmd.RunSQL "delete * from sendfiletemp" DoCmd.OpenQuery "Deprog3" Dim MyDB As DAO.Database Dim rst As DAO.Recordset Set MyDB = CurrentDb Set rst = MyDB.OpenRecordset("SendFileTemp", dbOpenForwardOnly) strSMTPFrom = Me.From strSMTPTo = Me.EMAIL strBCC = Me.BCC strSMTPRelay = "mail.vaioni.com" strSubject = "Jobs requiring your attention" With rst Do While Not .EOF MailBody = MailBody & ![serviceid] & " | " & ![status] & " | " & ![EventDate] & " | " & ![name] & vbCrLf .MoveNext Loop End With Set oMessage = CreateObject("CDO.Message") oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPRelay oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 oMessage.Configuration.Fields.Update oMessage.From = strSMTPFrom oMessage.To = strSMTPTo oMessage.bcc = strBCC oMessage.Subject = strSubject oMessage.TextBody = "Can you please take a look at these jobs that remain open and close them down. Thanks " & vbCrLf & " " & vbCrLf & MailBody & vbCrLf & " " oMessage.Send rst.Close Set rst = Nothing Me.Recordset.MoveNext Loop End Sub