Need VBA for sending email from query result by recordset

[aflores41]

Thanks. Looking forward to your response.

[aflores41]

Could someone help me with the code below. I'm trying to add records in the body that's associated by email address for example:

Body of email:

text...
record1
record2
record3
record4

all records that corresponds to the email address in to box. See image below.

Line 27 and 28 should loop the records inside the body of the email message. It's not. Could someone help me fix the code?

Many thanks!

Public Function CreateRIT2_ReportEmail()
    Dim OlApp As Object
    Dim OlMail As Object
    Dim olMailItem As Integer
    Dim ToRecipient As String
    Dim db As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim rst3 As DAO.Recordset
    Dim strSQL As String
    
    Set OlApp = CreateObject("Outlook.Application")
    Set db = CurrentDb
    Set rst1 = db.OpenRecordset("qry_Email distinct", dbOpenDynaset)
    Set rst3 = db.OpenRecordset("qry_email", dbOpenDynaset)
           
    If Not rst1.RecordCount = 0 Then
        rst1.MoveFirst
        Do While Not rst1.EOF
            Set OlMail = OlApp.CreateItem(olMailItem)
            OlMail.To = rst1!Email
            OlMail.Subject = rst3![ID]
            strSQL = "SELECT * FROM qry_EMAIL WHERE [email] = '" & rst1![Email] & "'"
            
                Set rst2 = db.OpenRecordset(strSQL, dbOpenDynaset)
                detsubject = "select * from query1 where [email] = '" & rst1![Email] & "'"
                strBody = "Dear " & "," & Chr(10) & Chr(10) & "Some kind of greeting" & "!" & _
                      "  email message body goes here" & detsubject
                If Not rst2.RecordCount = 0 Then
                    rst2.MoveFirst
                
                Do While Not rst2.EOF
                OlMail.Body = strBody
                    'Build the body of your message here
                    rst2.MoveNext
                Loop
            End If
            rst2.Close
            Set rst2 = Nothing
             OlMail.Display
            'Send your e-mail here
            rst1.MoveNext
        Loop
    End If
    rst1.Close
    db.Close
    Set rst1 = Nothing
    Set db = Nothing
End Function

[twinnyfo]

Line 34:

We have no idea what is contained in rst2, but this is where you build your e-mail content, based on the values in that recordset.

[aflores41]

Twinn,

Thank you. That's why I have this on line 32

OlMail.Body = strBody

the rst2 query has 2 fields: details and email.

Details field is concatenation of all fields from rst3 (line 15). Based on the attached image, it's not looping to add all records that have similar email address from line 26.

[twinnyfo]

But you have to build that yourself. strBody should be build with all the records of rst2 before you execute that line.

Line 34 could be:

strBody = strBody & "Your bought this item: " & _
    rst2!Details
rst2.MoveNext

This builds your message based on the multiple items in rst2. I'm not sure there is a need for rst3.

[aflores41]

Twinn,

Thank you. I think we're really close. I think we're getting confused with the fields on tables. The code from above doesn't work and the body does not have any population. Please see attached and if you could assist me into completing this.

Many thanks again.

Public Function CreateRIT2_ReportEmail()
    Dim OlApp As Object
    Dim OlMail As Object
    Dim olMailItem As Integer
    Dim ToRecipient As String
    Dim db As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim rst3 As DAO.Recordset
    Dim rst4 As DAO.Recordset
    Dim strSQL As String
    
    Set OlApp = CreateObject("Outlook.Application")
    Set db = CurrentDb
    Set rst1 = db.OpenRecordset("qry_Email distinct", dbOpenDynaset)
    Set rst3 = db.OpenRecordset("query1", dbOpenDynaset)
           
    If Not rst1.RecordCount = 0 Then
        rst1.MoveFirst
        Do While Not rst1.EOF
            Set OlMail = OlApp.CreateItem(olMailItem)
            OlMail.To = rst1!Email
            strSQL = "SELECT * FROM qry_EMAIL WHERE [email] = '" & rst1![Email] & "'"
            
                Set rst2 = db.OpenRecordset(strSQL, dbOpenDynaset)
                detsubject = "select * from query1 where [email] = '" & rst1![Email] & "'"
                strBody = "Dear " & "," & Chr(10) & Chr(10) & "Some kind of greeting" & "!" & _
                      "  email message body goes here" & detsubject
                If Not rst2.RecordCount = 0 Then
                    rst2.MoveFirst
                
                Do While Not rst3.EOF
                OlMail.Subject = rst2![ID]
                OlMail.Body = strBody = strBody & "You bought this item: " & _
                    rst3!Details
                    rst3.MoveNext
                Loop
            End If
            rst2.Close
            Set rst2 = Nothing
             OlMail.Display
            'Send your e-mail here
            rst1.MoveNext
        Loop
    End If
    rst1.Close
    db.Close
    Set rst1 = Nothing
    Set db = Nothing
End Function

[twinnyfo]

It seems you are not following much of the advice offered on this thread.

Lines 9, 10, 16 - Delete. These are unnecessary.

Lines 26 and 28: I don't understand your use of detSubject. You are adding "select * from query1 where [email] = 'abc@xyz.com'" to your message.

Line 32: We are still in rst2

Line 33:

OlMail.Subject = "The Subject of Your E-Mail

Line 34: still rst2

strBody = strBody & "You bought this item: " & _
    rst2!Details

NB: I don't know if you have a field called "Details" in your table. That was put there, because I still have no clue what is in your tables.

Line 36: rst2 again!

Line 40.5:

OlMail.Body = strBody

[aflores41]

twinn,

thank you. Okay, I have this code now, sorry I can't follow your coding that well.

Thanks.

Public Function CreateRIT2_ReportEmail()
    Dim OlApp As Object
    Dim OlMail As Object
    Dim olMailItem As Integer
    Dim ToRecipient As String
    Dim db As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    'Dim rst3 As DAO.Recordset
    'Dim rst4 As DAO.Recordset
    Dim strSQL As String
 
    Set OlApp = CreateObject("Outlook.Application")
    Set db = CurrentDb
    Set rst1 = db.OpenRecordset("qry_Email distinct", dbOpenDynaset)
    'Set rst3 = db.OpenRecordset("query1", dbOpenDynaset)
 
    If Not rst1.RecordCount = 0 Then
        rst1.MoveFirst
        Do While Not rst1.EOF
            Set OlMail = OlApp.CreateItem(olMailItem)
            OlMail.To = rst1!Email
            strSQL = "SELECT * FROM qry_EMAIL WHERE [email] = '" & rst1![Email] & "'"
 
                Set rst2 = db.OpenRecordset(strSQL, dbOpenDynaset)
                detsubject = "select * from query1 where [email] = '" & rst1![Email] & "'"
                strBody = "Dear " & "," & Chr(10) & Chr(10) & "Some kind of greeting" & "!" & _
                      "  email message body goes here" & detsubject
                If Not rst2.RecordCount = 0 Then
                    rst2.MoveFirst
 
                Do While Not rst2.EOF
                OlMail.Subject = rst2![ID]
                
                    rst2.MoveNext
                Loop
            End If
            rst2.Close
            Set rst2 = Nothing

            OlMail.Body = strBody '= strBody & "You bought this item: " & _
                    rst2!Details
            OlMail.Display
            'Send your e-mail here
            rst1.MoveNext
        Loop
    End If
    rst1.Close
    db.Close
    Set rst1 = Nothing
    Set db = Nothing
End Function

The code is still not looping into adding records. Please see attached db for tables and their fields.

Thank you.

[aflores41]

Code is still not working. If anyone out there could help.

This code outputs an email with:

Some kind of greeting! email message body goes hereselect * from query1 where query1.[email] = 'mix@mix.com'

I wanted to have an output where email address is the same as email address from distinct table list all records corresponding that email address.

for example: mix@mix.com
record1
record2
record3
record4
record5

See code below. Please assist.

Public Function CreateRIT2_ReportEmail()
    Dim OlApp As Object
    Dim OlMail As Object
    Dim olMailItem As Integer
    Dim ToRecipient As String
    Dim db As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim rst3 As DAO.Recordset
    Dim rst4 As DAO.Recordset
    Dim strSQL As String
 
    Set OlApp = CreateObject("Outlook.Application")
    Set db = CurrentDb
    Set rst1 = db.OpenRecordset("qry_Email distinct", dbOpenDynaset)
    Set rst3 = db.OpenRecordset("query1", dbOpenDynaset)
 
    If Not rst1.RecordCount = 0 Then
        rst1.MoveFirst
        Do While Not rst1.EOF
            Set OlMail = OlApp.CreateItem(olMailItem)
            OlMail.To = rst1!Email

                'rst2 = strsql
                strSQL = "SELECT * FROM qry_EMAIL WHERE qry_EMAIL.[email] = '" & rst1![Email] & "'"
                Set rst2 = db.OpenRecordset(strSQL, dbOpenDynaset)
                'body of email
                detsubject = "select * from query1 where '" & rst3![Email] & "' = '" & rst1![Email] & "'"
                strBody = "Dear " & "," & Chr(10) & Chr(10) & "Some kind of greeting" & "!" & _
                      "  email message body goes here" & detsubject
                If Not rst2.RecordCount = 0 Then
                    rst2.MoveFirst
 
                Do While Not rst2.EOF
                OlMail.Subject = rst2![ID]
                
                    rst2.MoveNext
                Loop
            End If
            rst2.Close
            Set rst2 = Nothing

            OlMail.Body = strBody '= strBody & "You bought this item: " & _
                    rst2!Details
            OlMail.Display
            'Send your e-mail here
            rst1.MoveNext
        Loop
    End If
    rst1.Close
    db.Close
    Set rst1 = Nothing
    Set db = Nothing
End Function

[twinnyfo]

aflores,

What amount of VBA coding experience do you have? It appears, to the casual observer, that you are adding various statements to your code without any comprehension of what they mean. If this is the case, there is little hope that any of us experts will be able to assist you much beyond your current state of success with this project.

Against my better judgment, I will modify your code to hopefully assist you in finalizing this thread.

Public Function CreateRIT2_ReportEmail()
    Dim OlApp As Object
    Dim OlMail As Object
    Dim olMailItem As Integer
    Dim db As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim strBody As String
    Dim strSQL As String

    Set OlApp = CreateObject("Outlook.Application")
    Set db = CurrentDb
    Set rst1 = db.OpenRecordset("qry_Email distinct", dbOpenDynaset)

    If Not rst1.RecordCount = 0 Then
        rst1.MoveFirst
        Do While Not rst1.EOF
            Set OlMail = OlApp.CreateItem(olMailItem)
            OlMail.To = rst1!EMail
            OlMail.Subject = "This is the Subject of Your E-Mail!"
            strBody = "Dear " & "," & Chr(10) & Chr(10) & _
                "Hello Person!  I am greeting you!" & vbCrLf & vbCrLf & _
                "This is the e-mail Body -- finish it please!" & vbCrLf & vbCrLf
            strSQL = "SELECT * FROM qry_EMAIL WHERE [email] = '" & rst1![EMail] & "'"

            Set rst2 = db.OpenRecordset(strSQL, dbOpenDynaset)
            If Not rst2.RecordCount = 0 Then
                rst2.MoveFirst
                Do While Not rst2.EOF
                    strBody = strBody & rst2![One of your Fields]
                    strBody = strBody & rst2![Another Field]
                    rst2.MoveNext
                Loop
            End If
            rst2.Close
            Set rst2 = Nothing

            OlMail.Body = strBody
            OlMail.Display
            'Send your e-mail here
            rst1.MoveNext
        Loop
    End If
    rst1.Close
    db.Close
    Set rst1 = Nothing
    Set db = Nothing
End Function

I have little confidence that this will work without you making necessary changes which reflect the actual data in the actual tables that your actual recordsets will be generating. Please review the code above and modify it so that it will take into account your specific data.

[aflores41]

Twinn,

I got your code to work. Thank you so much! Just needed to modify the query.

This inquiry is now closed! See complete code below.

Public Function CreateRIT23_ReportEmail()
Dim OlApp As Object
Dim OlMail As Object
Dim olMailItem As Integer
Dim db As DAO.Database
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim strBody As String
Dim strSQL As String

Set OlApp = CreateObject("Outlook.Application")
Set db = CurrentDb
Set rst1 = db.OpenRecordset("qry_Email distinct", dbOpenDynaset)

If Not rst1.RecordCount = 0 Then
rst1.MoveFirst
Do While Not rst1.EOF
Set OlMail = OlApp.CreateItem(olMailItem)
OlMail.To = rst1!Email
OlMail.Subject = "This is the Subject of Your E-Mail!"
strBody = "Dear " & "," & Chr(10) & Chr(10) & _
"Hello Person!  I am greeting you!" & vbCrLf & vbCrLf & _
"This is the e-mail Body -- finish it please!" & vbCrLf & vbCrLf
strSQL = "SELECT * FROM qry_EMAIL WHERE [email] = '" & rst1![Email] & "'"

Set rst2 = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not rst2.RecordCount = 0 Then
rst2.MoveFirst
Do While Not rst2.EOF
strBody = strBody & rst2![expr1] & vbCrLf & vbCrLf
'strBody = strBody & rst2![Emaila]
rst2.MoveNext
Loop
End If
rst2.Close
Set rst2 = Nothing

OlMail.Body = strBody
OlMail.Display
'Send your e-mail here
rst1.MoveNext
Loop
End If
rst1.Close
db.Close
Set rst1 = Nothing
Set db = Nothing
End Function

[aflores41]

Twinn,

Could you help me modify the query above into instead of sending the transactions as part of the body of the email into sending it as excel attachment?

Same rules apply as to grouping the email by a field i.e. Name.

Let me know if you have any questions.

Thanks Twinn!

[twinnyfo]

Just export the query to Excel, keeping track of the path and file name, then include it as an attachment:

OlMail.Body = strBody
OlMail.Attachment.Add "FilePath\FileName.xlsx"
OlMail.Display

Hope this hepps!

[aflores41]

Thanks Twinn. However, the query sends out mass email by grouping data into based on grouped field so there'll be many saved files in the folder if we do it this way. I guess the question is how do I automatically attach the saved file to the correct email if we do it this way.
Thanks.

[twinnyfo]

There is no way to "attach" a query or report in Excel format. You must save it first. You could simply delete the files you create once you send them ("Kill" Statement), so delete everything in the folder when you are complete.