在VBA中循环访问两个记录集

我正在尝试将来自名为“ 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

pl079qj2009 回答:在VBA中循环访问两个记录集

使用Recordset要求表单的第一条记录具有焦点。建议您使用RecordsetClone。

在每次迭代结束时将MailBody设置为空字符串。

考虑:

strSMTPRelay = "mail.vaioni.com"'

With Me.RecordsetClone
Do While Not .EOF

    Set rst = MyDB.OpenRecordset("SendFileTemp",dbOpenForwardOnly)
    With rst
    Do While Not .EOF
        MailBody = MailBody & ![serviceid] & " | " & ![status] & " | " & ![EventDate] & " | " & ![name] & vbCrLf
        .MoveNext
    Loop
    End With
    rst.Close

    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 = !From
    oMessage.To = !EMAIL
    oMessage.bcc = !BCC
    oMessage.Subject = "Jobs requiring your attention"
    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
    MailBody = ""
    .MoveNext
Loop
End With
本文链接:https://www.f2er.com/2977797.html

大家都在问