Need VBA for sending email from query result by recordset

[aflores41]

http://bytes.com/topic/access/answer...il-based-query

Best example is from the link above however, I need it to be modified.

Basically, I have a query with many fields. 3 fields are email address where I needs to send emails our grouping records as attachment or part of the body in the email detailing transactions. The query is for delinquent payments.

Requirement:
3 fields = Email, Del Email, Bur Email
I need the recordsets with to be grouped by those 3 fields and an email sent. So for example under 1-10 records with email [e-mail] i click a button and an email will be sent to [e-mail] then moves to another email address grouping the recordset with that criteria then loop.

the second button with [e-mail] in [del email] field will send all recordset grouping transaction inside that query and adding it in the body or template from text box then loop. and same goes for bur email.

I hope this is clear.

Also, I would like to upload or paste a template in a textbox to be used so no added fields needed to be created to limit the size of the db.

I've attached a sample with dummy data on query and a sample result however it will be looped to email the rest of the records based on grouped column.

Could someone please help? I feel like this is out of my skill level.

thank you!

[twinnyfo]

aflores41,

We typically don't write your code for you. You must make a valid attempt at working through this and we will be glad to assist and trouble shoot.

Additionally, I think I might understand what you want to do, but it is unclear. I also definitely do not understand what you mean by:

Also, I would like to upload or paste a template in a textbox to be used so no added fields needed to be created to limit the size of the db.

You may have to explain that one a little better.

[aflores41]

I meant to either paste an email template (e.g. The card information is below: _field__ , field, field, . Please pay the amount field, field.

The concept is similar to mail merge when using word and outlook. So it's either uploading an oft (outlook template file) as template or pasting it in a text box.

I was working on different codes actually and none of them works. See below.

This code is for the browse button to use .oft file as template then loop to send email:

Dim ahtFilter As String
  Dim ahtExtension As String
  Dim ahtFileName As String
 
 
  ahtFilter = "Outlook Template files (*.OFT)"
  ahtExtension = "*.OFT"
  ahtFileName = "*.OFT"
 
  Me.txt_email = OpenFile(Me.txtDir, Me.txtZipFileName1, ahtFilter, ahtExtension, ahtFileName)
 
 
The browse vba came with a public function in module:
 
Public Function OpenFile _
(Optional varDirectory As Object, _
 Optional MyFileName As Object, _
 Optional ahtFilter As String, _
 Optional ahtExtension As String, _
 Optional ahtFileName As String) As Variant
 
 
    Dim strFilter As String
    Dim lngFlags As Long
    Dim varFileName As Variant
    Dim curr_year As String
    Dim filename As String
 
    lngFlags = ahtOFN_FILEMUSTEXIST Or ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
 
'''''    If IsMissing(varDirectory) Or IsNull(varDirectory) Then
'''''        varDirectory = Me.DbDir & "\Imports\"
'''''    End If
 
 
' you can choose to add a number of file extensions which will appear in the drop down Files of Type box
strFilter = ahtAddFilterItem(strFilter, ahtFilter, ahtExtension)
filename = varDirectory & ahtFileName
'strFilter = ahtAddFilterItem(strFilter, "Any files (*.*)", "*.*")
varFileName = ahtCommonFileOpenSave( _
filename:=filename, _
MyFileName:=MyFileName, _
OpenFile:=True, _
InitialDir:=varDirectory, _
Filter:=strFilter, _
Flags:=lngFlags, _
DialogTitle:="Open an Outlook Template file ...") ' < This is the title to your dialog box
 
 
 
OpenFile = varFileName
 
 
 
End Function
 
 
I also tried using the below vba however, it does not loop and there's an error when sending the message. I was also getting an error when using stremail as a source for email addresses. Typing in emails manual sends the email but defeats the purpose of sending it from a field.
 
Thank you very much!
 
Public Function CreateRIT_ReportEmail_works_but_not_complete()
'write the default Outlook contact name list to the active worksheet
Dim rs As DAO.Recordset
Dim OlApp As Object
Dim OlMail As Object
Dim ToRecipient As String
 
  Set OlApp = CreateObject("Outlook.Application")
  Set OlMail = OlApp.CreateItem(olMailItem)
 
  Set rs = CurrentDb.OpenRecordset("email end of month")
  With rs
           Do Until rs.EOF
            stremail = ![email]
            strSubject = ![Hierarchy level 4]
            strBody = "Dear " & "," & Chr(10) & Chr(10) & "Some kind of greeting" & "!" & _
                      "  email message body goes here"
 
            '.Edit
            'rs.Update
 
            'Set OutMail = OutApp.CreateItem(olMailItem)
 
            With OlMail
              DoCmd.SetWarnings False
                .To = stremail
                .CC = ""
                .BCC = ""
                .Subject = strSubject
                .Body = strBody
 
                '.SendUsingAccount = OutApp.Session.Accounts.Item(2)
                .Send
                DoCmd.SetWarnings True
            End With
 
            .MoveNext
        Loop
End With
 
 
End Function

[twinnyfo]

Please use Code Tags when including code. It is much easier for us to follow in that format.

You mention you receive several errors, but you do not mention what those errors are, or where they occur. It is impossible to help without that information.

Concerning the not looping to send multiple e-mails, I think you can start by setting your OLItem after you get into the Recordset.

Do Until rs.EOF
    Set OlMail = OlApp.CreateItem(olMailItem)
    stremail = ![email]
    strSubject = ![Hierarchy level 4]
    etc....

You set the object once and then send it. Once you send it, it doesn't really exist any more.

My DB sends tons of e-mail (via looping) and I never use any Templates, as I just create the body myself. I believe it is possible to create an HTML email body, but I have not had success with it, so I have not worked with it much.

[aflores41]

Twinnyfo,

I apologize. I'm new with this site. For code below:

Public Function CreateRIT_ReportEmail()
'write the default Outlook contact name list to the active worksheet
Dim rs As DAO.Recordset
Dim OlApp As Object
Dim OlMail As Object
Dim ToRecipient As String
 
  Set OlApp = CreateObject("Outlook.Application")
  Set OlMail = OlApp.CreateItem(olMailItem)
 
  Set rs = CurrentDb.OpenRecordset("Email")
  With rs
           Do Until rs.EOF
            stremail = ![email]
            strSubject = ![Account Number (Short)]
            strBody = "Dear " & "," & Chr(10) & Chr(10) & "Some kind of greeting" & "!" & _
                      "  email message body goes here"
 
            '.Edit
            'rs.Update
 
            'Set OutMail = OutApp.CreateItem(olMailItem)
 
            With OlMail
              DoCmd.SetWarnings False
                .To = stremail
                .CC = ""
                .BCC = ""
                .Subject = strSubject
                .Body = strBody
 
                '.SendUsingAccount = OutApp.Session.Accounts.Item(2)
                .Send
                DoCmd.SetWarnings True
            End With
 
            .MoveNext
        Loop
End With
 
 
End Function

It works sending out mail and the loop works too! thank you! I'm searching through online on how to get rid of the warning prompt as to allow sending out emails. Suggestions are welcome.

Also, do you have any suggestions on grouping the email sent based on data on fields? i.e. send email to [e-mail] including all recordset associated with that email then next email is for [e-mail] with all associated recordset.

I was thinking of making reports however; it defeats the purpose of the coding.. and the db will get bigger.

Thanks again!

[aflores41]

Follow up.. work around to outlook warning prompt is..

            With OlMail
                .To = stremail
                .CC = ""
                .BCC = ""
                .Subject = strSubject
                .Body = strBody
                .Display
 
 
                '.SendUsingAccount = OutApp.Session.Accounts.Item(2)
                '.Send
 
            End With
            SendKeys "%S"
            .MoveNext
        Loop
End With
 

[twinnyfo]

aflores41,

Did this solution work for you? Any snags that you have run across?

[aflores41]

The solution for sending emails works. Thanks! However, I need to modify the code to send emails enclosing group of transactions inside if it's going to one email address.

For now, the email is being sent to individual recordset. I wanted to use a "group by" when there are multiple recordset that's going to the same email address.

Do you have any suggestion into grouping these records into one when sending email?

Thanks.

-Aflores

[twinnyfo]

Aflores,

I'm not sure I follow your question:

send emails enclosing group of transactions inside if it's going to one email address

and

I wanted to use a "group by" when there are multiple recordset that's going to the same email address.

If I do follow you correctly, you want:

I have a list of e-mail addresses and a list of e-mail bodies that must go out to these e-mail addresses. I have two separate e-mail bodies that are going to the same e-mail address, and I want to combine the two e-mail bodies into one, so that the recipient only receives one e-mail instead of two (or more).

Is that correct?

[aflores41]

So basically, the macro written sends email to the addresses from a field. In the body of the email, if there are multiple records that could be grouped by one email address from the field, then it details the record information of how many number of records and send it into one email address. Same concept with group by.. send email to one address as group by but the records are in the body..


For example,

[e-mail]

body:
record1
record2
record3
record4

[e-mail]
body:
record5

[e-mail]
body:
record6
record7
record8

-Aflores

[twinnyfo]

Got it (I'm pretty sure). I use this same method all the time.

Concept: Create a recordset that generates your list of all e-mail Recipients. This recordset could be a query based on the current query, but only returns an aggregate query of the e-mail addresses. So, your first query/.recordset will return the following values:

[e-mail]
[e-mail]
[e-mail]

NOT this:

[e-mail]
[e-mail]
[e-mail]
[e-mail]
[e-mail]
[e-mail]
[e-mail]
[e-mail]

Then, within your code, you nest another recordset that pulls all the information based on e-mail Address. Here, is what one of our experts here (Rabbit) likes to call "pseudo code":

Private Sub SendEmails()
    'Declare your Variables
    Set rst1 = 'gather your e-mail addresses
    Do While Not rst1.EOF
        Set rst2 = 'Your Other Query: WHERE EMailAddress = '" & rst1!EMailAddress & "';"
        Do While Not rst2.EOF
            'Build Your E-Mail Message
            rst2.MoveNext
        Loop
        'Send your E-Mail
        rst1.MoveNext
    Loop
End Sub

I hope this makes sense. let us know if you come across any hitches.

[aflores41]

Okay, I understand what your saying and it makes sense however I don't think I'm able to merge the two codes.

See below for the codes I tried using but an error came out as:
Compile error: Method or data member not found.
- not sure how to add the third recordset.

Sample code:

Public Function CreateRIT_ReportEmail()
Dim rs As DAO.Recordset
Dim rst1 As DAO.Recordset2
Dim rst2 As DAO.Recordsets
 
    Set rst2 = CurrentDb.OpenRecordset("Email")
    'rst1 is the distinct email addresses from rst2
    Set rst1 = CurrentDb.OpenRecordset("distinct Email")
    Do While Not rst1.EOF
        Set rst2 = rst1
        Do While Not rst2.EOF
            'Build Your E-Mail Message
            rst2.MoveNext
        Loop
          With rs
           Do Until rs.EOF
 
            'OlSecurityManager.DisableOOMWarnings = True
            Set OlMail = OlApp.CreateItem(olMailItem)
            stremail = ![email]
            strSubject = ![Account Number (Short)]
            strBody = "Dear " & "," & Chr(10) & Chr(10) & "Some kind of greeting" & "!" & _
                      "  email message body goes here"
                With OlMail
                .To = stremail
                .CC = ""
                .BCC = ""
                .Subject = strSubject
                .Body = strBody
                .Display
 
             End With
             SendKeys "%S"
                .MoveNext
            Loop
            End With
 
        'Send your E-Mail
        rst1.MoveNext
    Loop
End Function
 

Thank you so much!

-aflores

[twinnyfo]

Recommendations:

Line 1.5: It is a good practice to declare a db:

Dim db as DAO.Database
then....
Set rs = db OpenRecordset("EMail")

This allows you to refer to that db once when setting the recordsets--otherwise your system is using duplicate resources setting aside space for the same DB.

Line 3: declare it as a Recordset, not Recordset2.
Line 4: declare it as a Recordset, not Recordsets.

Lines 6ff: It is clear you did not understand the concept. I'm not al all clear what you were trying to do. Here is a go:

Public Function CreateRIT_ReportEmail()
    Dim db As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim strSQL As String
 
    'rst1 is the distinct email addresses
    Set rst1 = Db.OpenRecordset("distinct Email")
    If Not rst1.RecordCount = 0 Then
        rst1.MoveFirst
        Do While Not rst1.EOF
            Set OlMail = OlApp.CreateItem(olMailItem)
            OlMail.To = rst1!email
            OlMail.Subject = rst1![Account Number (Short)]
            strSQL = "SELECT * FROM EMAIL WHERE [email] = '" & rst1![email] & "'"
            Set rst2 = Db.OpenRecordset(strSQL, dbOpenDynaset)
            If Not rst2.RecordCount = 0 Then
                rst2.MoveFirst
                Do While Not rst2.EOF
                    'Build the body of your message here
                    rst2.MoveNext
                Loop
            End If
            rst2.close
            Set rst2 = Nothing
            'Send your e-mail here
            rst1.MoveNext
        Loop
    End If
    rst1.Close
    db.Close
    Set rst1 = Nothing
    Set db = Nothing
End Function

Note Lines 20 and 26. This is where you need to accomplish the required tasks.

It is still not clear what is being put into the body of the e-mail. If the content is different for each record, should it be in one e-mail or several?

[aflores41]

For example:

Column1 Column2 Column3 Column4 Column5 Column6
123 John Doe $12345 $54321 [e-mail]
124 Jane Doe $54321 $12345 [e-mail]
125 Jane Jane $55555 $22222 [e-mail]
126 Joe Joe $12321 $23232 [e-mail]

So the goal is the macro would send an email to the following:
[e-mail]
Body:
message...:
123 John Doe $12345 $54321
124 Jane Doe $54321 $12345

signature
aklsfhasklfh

then another email sent to
[e-mail]
body:
message...:
125 Jane Jane $55555 $22222
signature
asfdasfa

then next and so on...

The macro would send 3 emails rather than 4... Hope this clears things up. thank you!

[aflores41]

Tried this code

Public Function CreateRIT_ReportEmail()
    Dim OlApp As Object
    Dim OlMail As Object
    Dim ToRecipient As String
    Dim db As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim strSQL As String
 
    'rst1 is the distinct email addresses
    Set db = CurrentDb
    Set rst1 = db.OpenRecordset("distinct Email")
    If Not rst1.RecordCount = 0 Then
        rst1.MoveFirst
        Do While Not rst1.EOF
            Set OlMail = OlApp.CreateItem(olMailItem)
            OlMail.To = rst1!Email
            OlMail.Subject = rst1![Account Number (Short)]
            strSQL = "SELECT * FROM EMAIL WHERE [email] = '" & rst1![email] & "'"
            Set rst2 = db.OpenRecordset(strSQL, dbOpenDynaset)
            If Not rst2.RecordCount = 0 Then
                rst2.MoveFirst
                Do While Not rst2.EOF
                    'Build the body of your message here
                    rst2.MoveNext
                Loop
            End If
            rst2.Close
            Set rst2 = Nothing
            'Send your e-mail here
            rst1.MoveNext
        Loop
    End If
    rst1.Close
    db.Close
    Set rst1 = Nothing
    Set db = Nothing
End Function
 

error came out for line 15 as run-time error '91':
object variable or with block variable not set.

Thank you!

-aflores

[twinnyfo]

Do you have queries (or tables) names "distinct Email" and "EMail"? The only reason those names are there is because I have to make assumptions about the names of your data, as you have not provided it.

Concerning Post #14, above, you must build the code to create the body of the multiple lined e-mails. I can't even begin to build it since I don't know the data that is in your tables--nor do I want to. These are things that we request our posters to work through themselves. We are glad to assist with trouble-shooting, but I want you to understand the concepts I am presenting (even more than I want your project to work). If you understand the concepts, you will be able to expand on those concepts and build more robust projects in the future.

[aflores41]

Yes for the first question. I did upload the file from the initial inquiry however, i'll reattach it and rename the queries. The query for distinct is [qry_email distinct] and query for email is [qry_email].

I really hope to get this code to work. I'm researching as well and keep hitting a wall.

Thank you so much for being patient with me.

[twinnyfo]

Just modify the code provided so that the recordsets are drawing their data from YOUR queries. This should at least get us moving in the right direction.

[aflores41]

I did modify the code

Public Function CreateRIT_ReportEmail()
    Dim OlApp As Object
    Dim OlMail As Object
    Dim ToRecipient As String
    Dim db As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim strSQL As String
 
 
 
    'rst1 is the distinct email addresses
    Set db = CurrentDb
    Set rst1 = db.OpenRecordset("qry_Email distinct")
    If Not rst1.RecordCount = 0 Then
        rst1.MoveFirst
        Do While Not rst1.EOF
            Set OlMail = OlApp.CreateItem(olMailItem)
            OlMail.To = rst1!Email
            OlMail.Subject = rst1![Account Number (Short)]
            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
                    'Build the body of your message here
                    rst2.MoveNext
                Loop
            End If
            rst2.Close
            Set rst2 = Nothing
            'Send your e-mail here
            rst1.MoveNext
        Loop
    End If
    rst1.Close
    db.Close
    Set rst1 = Nothing
    Set db = Nothing
End Function

error came out for line 15 as run-time error '91':
object variable or with block variable not set.

[twinnyfo]

Do you have the lines:

Option Compare Database
Option Explicit

At the top of your modules? If not, place them there. Then debug your code (Debug Menu, Compile). Then fix any blatant errors.

Also, you may want to change line 14:

Set rst1 = db.OpenRecordset("qry_Email distinct", dbOpenDynaset)

It "shouldn't" make a difference, but it might.

[aflores41]

Error on line 23,
error code: run-time error '91':
object variable or with block variable not set.

Option Compare Database
Option Explicit
 
 
Public Function CreateRIT_ReportEmail()
    Dim OlApp As Object
    Dim OlMail As Object
    Dim olMailItem As Object
    Dim ToRecipient As String
    Dim db As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim strSQL As String
 
 
 
    'rst1 is the distinct email addresses
    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 = rst1![Account Number (Short)]
            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
                    'Build the body of your message here
                    rst2.MoveNext
                Loop
            End If
            rst2.Close
            Set rst2 = Nothing
            'Send your e-mail here
            rst1.MoveNext
        Loop
    End If
    rst1.Close
    db.Close
    Set rst1 = Nothing
    Set db = Nothing
End Function
 
 

I added Dim olMailItem As Object, thinking it might fix the problem but didn't.

[aflores41]

I might have found a work around but I might need some ideas with this. I was thinking of creating subdatasheet to group the records by email. Question is how do I send the subdatasheet records that's under the email when expanded?

Thanks. Still the same error from the above code.

[Rabbit]

Line 23, OlApp, you never set that to anything. It has nothing to work on. You may have declared the variable. But the variable isn't set to anything.

[aflores41]

I've set OlApp, however OlMail errors out on line 16. Here's the code below.
error is run-time error 13, type mismatch.
olapp is set in line 10.
Thank you.

Public Function CreateRIT_ReportEmail()
    Dim OlApp As Object
    Dim OlMail As Object
    Dim olMailItem As Object
    Dim ToRecipient As String
    Dim db As DAO.Database
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    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 = rst1![Account Number (Short)]
            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
                    'Build the body of your message here
                    rst2.MoveNext
                Loop
            End If
            rst2.Close
            Set rst2 = Nothing
            'Send your e-mail here
            rst1.MoveNext
        Loop
    End If
    rst1.Close
    db.Close
    Set rst1 = Nothing
    Set db = Nothing
End Function
 
 

Also, your name was mentioned before on the previous post and was wondering if you could help me.

The goal is really this:
The macro to send 3 emails rather than 4

For example:

Column1 Column2 Column3 Column4 Column5 Column6
123 John Doe $12345 $54321 [e-mail]
124 Jane Doe $54321 $12345 [e-mail]
125 Jane Jane $55555 $22222 [e-mail]
126 Joe Joe $12321 $23232 [e-mail]

So the goal is the macro would send an email to the following:
[e-mail]
Body:
message...:
123 John Doe $12345 $54321
124 Jane Doe $54321 $12345

signature
aklsfhasklfh

then another email sent to
[e-mail]
body:
message...:
125 Jane Jane $55555 $22222
signature
asfdasfa

then next and so on...

Thank you!


- I'm playing around with subdatasheet and trying to figure out if I could email the subdatasheet of a query but haven't found anything so far.

[Rabbit]

olMailItem is an object that you declared. The CreateItem method expects an integer, not an object.

[twinnyfo]

Delete line 4 and line 16 should then work.

[Rabbit]

You need line 16, you just need to find out what the constant is mapped to and put that in because the outlook constants are out of scope.

[zmbd]

read this: Bulk-Batch Email From Microsoft Access

The sendkey workaround... yuck.
Once the email object is created it can be sent using the send property. refer to the article.

[aflores41]

Thanks zmbd. Hopefully, I could understand the coding and alter it to my use. I wanted to send the concatnated records as a group by to one email address though but I guess I could try and do it manually. I was hoping there was a code out there that would do this automatically. I'll post updates if any.

[zmbd]

should be able to do that... let me re-read the thread here and see what hits me, been a madhouse on my end and very little time to accomplish anything without interruptions..

[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] = '[e-mail]'" 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] = '[e-mail]'

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: [e-mail]
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.