Need VBA for sending email from query result by recordset

[aflores41]

http://bytes.com/topic/access/answers/891050-send-email-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 1@1.com i click a button and an email will be sent to 1@1.com then moves to another email address grouping the recordset with that criteria then loop.

the second button with 2@2.com 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 af@af.com including all recordset associated with that email then next email is for mix@mix.com 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,

ax@ax.com

body:
record1
record2
record3
record4

ax2@ax2.com
body:
record5

ax3@ax3.com
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:

ax@ax.com
ax2@ax2.com
ax3@ax3.com

NOT this:

ax@ax.com
ax@ax.com
ax@ax.com
ax@ax.com
ax2@ax2.com
ax3@ax3.com
ax3@ax3.com
ax3@ax3.com

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 af@af.com
124 Jane Doe $54321 $12345 af@af.com
125 Jane Jane $55555 $22222 mx@mx.com
126 Joe Joe $12321 $23232 gs@gs.com

So the goal is the macro would send an email to the following:
af@af.com
Body:
message...:
123 John Doe $12345 $54321
124 Jane Doe $54321 $12345

signature
aklsfhasklfh

then another email sent to
mx@mx.com
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