Send an outlook email to each record in the table in a table format

Donnie1ben · Aug 15, 2022

I have a MS Access table and want to send an email to each record in the table in a table format. For row in the table bearing same city or Country, I expect the outlook email to have those records in one table.

I have included a dummy table whose records I would retrieve using an SQL query: SELECT * FROM DummyTable (like in Dummyimage) I have created the table in vba using this solution I found here

Code:

Public Sub NewEmail()

Dim olApp As Object
Dim olItem As Variant
Dim db As DAO.Database
Dim rec As DAO.Recordset
Dim strQry As String
Dim aHead(1 To 7) As String
Dim aRow(1 To 7) As String
Dim aBody() As String
Dim lCnt As Long

'Create the header row
aHead(1) = "Request Type"
aHead(2) = "ID"
aHead(3) = "Title"
aHead(4) = "Requestor Name"
aHead(5) = "Intended Audience"
aHead(6) = "Date of Request"
aHead(7) = "Date Needed"

lCnt = 1
ReDim aBody(1 To lCnt)
aBody(lCnt) = "<HTML><body><table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>"

'Create each body row
strQry = "SELECT * From Email_Query"
Set db = CurrentDb
Set rec = CurrentDb.OpenRecordset(strQry)

If Not (rec.BOF And rec.EOF) Then
    Do While Not rec.EOF
        lCnt = lCnt + 1
        ReDim Preserve aBody(1 To lCnt)
        aRow(1) = rec("Test1")
        aRow(2) = rec("Test2")
        aRow(3) = rec("Test3")
        aRow(4) = rec("Test4")
        aRow(5) = rec("Test5")
        aRow(6) = rec("Test6")
        aRow(7) = rec("Test7")
        aBody(lCnt) = "<tr><td>" & Join(aRow, "</td><td>") & "</td>
</tr>"
        rec.MoveNext
    Loop
End If

aBody(lCnt) = aBody(lCnt) & "</table></body></html>"

'create the email
Set olApp = CreateObject("Outlook.application")
Set olItem = olApp.CreateItem(0)

olItem.display
olItem.To = "example@example.com"
olItem.Subject = "Test E-mail"
olItem.htmlbody = Join(aBody, vbNewLine)
olItem.display

End Sub

My ideal solution would result in this table as the email body if I want to send an email to names in my table whose country are TRNC in "Dummyimage1" and for country UK a separate table for the email body as in "Dummyimage2"

My approach would be to create an array to hold the records from the DummyTable and then loop through each record and create a table for records with same country names, but my implementation fails me and I've been on this for 2 weeks.

theDBguy · Aug 16, 2022

Hi. I think someone has a function available to convert a table or recordset into an HTML table. I'll see if I can find it.

Gasman · Aug 16, 2022

I just read each record and added the tags per field? No array needed?

arnelgp · Aug 16, 2022

you can try to use Allen Browne's OutputHtml() function.

Allen Browne - Export data to web pages

How to create web pages that display the contents of your Access tables and queries.

allenbrowne.com

then on the .htmlbody property, read the html file:

.htmlbody = CreateObject("scripting.filesystemobject").opentextfile("theHTMfile").readall

Donnie1ben · Aug 21, 2022

I have gone through the Allen Browne's output but cant seem to tailor it to my solution. I found a similar solution in the Send email to Unique Users in Range Thread. @arnelgp. In the solution I refer to, I also encounter problems in the specific line "Set rs2 = db.OpenRecordset(strQryEmailBody)". It appears nothing is parsed to this recordset.

This is the code :

Code:

Public Sub SendSerialEmail()

    Dim olApp As Object
    Dim olItem As Variant
    Dim db As DAO.Database
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim strQryEmailBody As String
    Dim aHead(1 To 5) As String
    Dim aRow(1 To 5) As String
    Dim aBody As String
    Dim lCnt As Long


    'Create the header row
    aHead(1) = "ID Associate"
    aHead(2) = "Name"
    aHead(3) = "Course Name"
    aHead(4) = "Status"
    aHead(5) = "Expired Date"
        
    lCnt = 1
    
    Set db = CurrentDb
    Set rs1 = db.OpenRecordset("qryForTraining")
    If Not (rs1.BOF And rs1.EOF) Then
        rs1.MoveFirst
    End If
    Do Until rs1.EOF
        strQryEmailBody = "SELECT * FROM qryEmailSupData " & "WHERE (((qryEmailSupData.DirectSupID)=" & rs1("DirectSupID") & "));"
        Set rs2 = db.OpenRecordset(strQryEmailBody)
        
        rs2.MoveFirst

        lCnt = 0
        aBody = "<HTML><body><table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>"
        Do Until rs2.EOF
            
            'Create each body row
                    lCnt = lCnt + 1
                    aRow(1) = rs2("IDAssociate")
                    aRow(2) = rs2("AssociateName")
                    aRow(3) = rs2("CourseName")
                    aRow(4) = rs2("Status")
                    aRow(5) = rs2("ExpiredDate") & vbNullString
                    aBody = aBody & "<tr><td>" & Join(aRow, "</td><td>") & "</td></tr>"
                    
                    rs2.MoveNext
                
        Loop
        rs2.Close
        Set rs2 = Nothing
        
        aBody = aBody & "</table></body></html>"

        'create the email
        Set olApp = CreateObject("Outlook.application")
        Set olItem = olApp.CreateItem(0)

        With olItem
            .To = rs1("SupervisorEmail").Value
            .Subject = "Test E-mail"
            .htmlbody = aBody
            .display
        End With
        
    
        rs1.MoveNext
    Loop
    
    rs1.Close
    Set rs1 = Nothing
    Set db = Nothing
    


End Sub

Send an outlook email to each record in the table in a table format

Donnie1ben

New member

Attachments

theDBguy

I’m here to help

Gasman

Enthusiastic Amateur

arnelgp

..forever waiting... waiting for jellybean!

Allen Browne - Export data to web pages

Donnie1ben

New member

Similar threads

Users who are viewing this thread