我正在尝试将来自名为“ Deprog3”的查询的电子邮件记录发送给多个不同的收件人。表单上的按钮需要遍历表单中的每个记录,并向收件人发送电子邮件(“ Me.EMAIL”)。它发送的电子邮件应从“ Deprog3”查询中选择与该特定个人相关的所有记录。
尽管实际上发生的是它只发送第一封电子邮件中第一个人的特定记录,然后发送第二封电子邮件中第一个人和第二个人的记录,依此类推,直到最后一封电子邮件包含来自查询。
如果我注释掉第二行(“ Do While Me.Current Record ...”)和第二行(最后一行)(“ Loop”),它将取消循环,这意味着我必须继续单击“发送” ,但不会发送以前个人的记录。
任何指导将不胜感激!
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