(Solved) – Looping two recordsets in VBA for Access

(solved)-–-looping-two-recordsets-in-vba-for-access

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

Leave a Reply

Your email address will not be published. Required fields are marked *