Отправить E-mail нескольким получателям, содержащим их записи, через CDO - PullRequest
Новая
       102

Отправить E-mail нескольким получателям, содержащим их записи, через CDO

1 голос
/ 29 января 2020

У меня есть код, который в настоящее время отправляет сообщение в формате HTML, который запрашивает записи из БД и затем отправляет определенную группу c людей.

Но я хочу расширить функцию кода в поиск получателей из таблицы в БД и отправка информации в формате 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 = "Test@TestMail.com"
            .Subject = "Record Summary"
            .send
            End With
        Set iMsg = Nothing
        Set iConf = Nothing
        Set Flds = Nothing

        Else
    Exit Function
End If
End Function

1 Ответ

2 голосов
/ 31 января 2020

Если вы хотите, чтобы каждый адрес получал отдельную электронную почту и включал в себя только записи, относящиеся к каждой электронной почте, то постройте тело электронной почты в пределах l oop адресов электронной почты. Это означает открытие набора адресов электронной почты и затем в этом l oop открытие набора связанных записей данных и l oop через этот набор записей. 

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 = "Test@TestMail.com"
        .Subject = "Record Summary"
        .Send
        End With
        mail.MoveNext
    Loop
    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing
End

Это может быть сделано с 1 упорядоченным набором записей, но для этого потребуется установить переменную с адресом электронной почты из записи и проверить, когда это письмо изменится в наборе записей, чтобы определить, когда следует отправлять электронную почту, и начать новый набор записи для следующего письма.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Похожие темы

...