通过CDO将电子邮件发送给包含其记录的多个收件人

问题描述 投票：0回答：1

我有一个当前发送HTML格式消息的代码，该消息从DB查询记录，然后发送给特定的人群。

但是我想将代码功能扩展为从数据库的表中查找收件人，并发送HTML格式的信息，其中包含特定收件人的记录。Sample Details代码

Public Function sendmail()

    Dim db As DAO.Database
    Dim rec As DAO.Recordset
    Dim strQry, strTo As String
    Dim aHead(1 To 11) As String
    Dim aRow(1 To 11) As String
    Dim aBody(), aBody2 As String
    Dim lCnt As Long
    Dim getdate As String
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant


    aHead(1) = "RecordID"
    aHead(2) = "Name"
    aHead(3) = "Gender"
    aHead(4) = "Transaction Code"
    aHead(5) = "Mobile"

    lCnt = 1
    ReDim aBody(1 To lCnt)
    aBody(lCnt) = "<HTML><body><br>Dear All,</br> <br>Good Day.</br> <br>Please refer below for the details of your current system records & " & _
    "Kindly assist to check and confirm. </br>  " & _
    "<br><table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>"

    strQry = "SELECT * FROM tblrecon "
    Set db = CurrentDb
    Set rec = CurrentDb.OpenRecordset(strQry)
    If rec.RecordCount <> 0 Then

    If Not (rec.EOF) Then
        Do While Not rec.EOF
            strTo = rec.Fields("Email")
            lCnt = lCnt + 1
            ReDim Preserve aBody(1 To lCnt)
            aRow(1) = rec("RecordID")
            aRow(2) = rec("Name")
            aRow(3) = rec("Gender")
            aRow(4) = rec("TransactionCode")
            aRow(5) = rec("Mobile")
            aBody(lCnt) = "<tr><td>" & Join(aRow, "</td><td>") & "</td></tr>"
            rec.MoveNext
        Loop
    End If

        aBody(lCnt) = aBody(lCnt) & "</table></body></html> <br> Sincerly, </br> <br> System Operator </br>"

        Set iMsg = CreateObject("CDO.Message")
        Set iConf = CreateObject("CDO.Configuration")
        iConf.Load -1
        Set Flds = iConf.Fields
        With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "MySMTPServer"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "Myport"
        .Update
        End With

            With iMsg
            Set .Configuration = iConf
            Do While rec.EOF And (rec.Fields("Email") = strTo)
            .HTMLBody = Join(aBody, vbNewLine)
            rec.MoveNext
            Loop

            .To = strTo
            .BCC = ""
            .From = "[email protected]"
            .Subject = "Record Summary"
            .send
            End With
        Set iMsg = Nothing
        Set iConf = Nothing
        Set Flds = Nothing

        Else
    Exit Function
End If
End Function
ms-access cdo
1个回答
1
投票

如果您希望将单个电子邮件发送给每个收件人，并且仅包含与每个电子邮件相关的记录，则在电子邮件地址循环内构建电子邮件记录主体。这意味着打开电子邮件地址记录集，然后在该循​​环中打开相关数据记录的记录集并遍历该记录集。 

Public Function sendmail()

    Dim db As DAO.Database
    Dim rec As DAO.Recordset
    Dim mail As DAO.Recordset

    Dim aHead(1 To 11) As String
    Dim aRow(1 To 11) As String
    Dim aBody(), aBody2 As String
    Dim lCnt As Long
    Dim getdate As String
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant

    aHead(1) = "RecordID"
    aHead(2) = "Name"
    aHead(3) = "Gender"
    aHead(4) = "Transaction Code"
    aHead(5) = "Mobile"

    Set db = CurrentDb
    Set mail = db.OpenRecordset("SELECT DISTINCT Email FROM tblrecon")

    While Not mail.EOF
        lCnt = 1
        ReDim aBody(1 To lCnt)
        aBody(lCnt) = "<HTML><body><br>Dear All,</br> <br>Good Day.</br> <br>Please refer below for the details of your current system records & " & _
        "Kindly assist to check and confirm. </br>  " & _
        "<br><table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>"
        Set rec = db.OpenRecordset("SELECT * FROM tblrecon WHERE Email='" & mail!Email & "'")
        If Not rec.EOF Then
            Do While Not rec.EOF
                lCnt = lCnt + 1
                ReDim Preserve aBody(1 To lCnt)
                aRow(1) = rec("RecordID")
                aRow(2) = rec("Name")
                aRow(3) = rec("Gender")
                aRow(4) = rec("TransactionCode")
                aRow(5) = rec("Mobile")
                aBody(lCnt) = "<tr><td>" & Join(aRow, "</td><td>") & "</td></tr>"
                rec.MoveNext
            Loop
            rec.Close
        End If

        aBody(lCnt) = aBody(lCnt) & "</table></body></html> <br> Sincerly, </br> <br> System Operator </br>"

        Set iMsg = CreateObject("CDO.Message")
        Set iConf = CreateObject("CDO.Configuration")
        iConf.Load -1
        Set Flds = iConf.Fields
        With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "MySMTPServer"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "Myport"
        .Update
        End With

        With iMsg
        Set .Configuration = iConf
        .HTMLBody = Join(aBody, vbNewLine)
        .To = mail!Email
        .BCC = ""
        .From = "[email protected]"
        .Subject = "Record Summary"
        .Send
        End With
    Loop
    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing
End

这可以通过1个有序记录集来完成，但是这需要从记录中设置一个带有电子邮件地址的变量，并检查记录集中电子邮件的更改时间，以确定何时应发送电子邮件并为下一封电子邮件开始新的记录集。

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.