How to get all records to .TextBody line from ADODB.Recordset /CDO.Message

[CostasM]

It is necessary to send e-mail from Access 2007 using CDO.Message
and in the TextBody get/add all results/records of recordset

Part of the code as follows:

Private Sub btn1_SendDA_Click()
 
On Error GoTo btn1_SendDA_Click_Error
 
 Dim Rst As ADODB.Recordset
 Dim strSQL As String
 
 Set Rst = New ADODB.Recordset
 
 
    strSQL = "select * from [qryDA-REQUEST]" 'source of recordset 
    Rst.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
 
Do While Not Rst.EOF
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Test Message"
objMessage.From = """SENDER"" <[e-mail]>"
objMessage.To = "[e-mail]"
objMessage.TextBody = ????? '(all records from Rst)
 
'........ extracted SMTP server configuration
 
objMessage.Send
Rst.MoveNext
Loop
 
Rst.Close
 
Set Rst = Nothing
.......
 

[Rabbit]

Use the append operator to append to the textbody as you loop through the recordset.

objMessage.TextBody = objMessage.TextBody & Rst("FieldName")

You should also move the rest of the message stuff outside the loop so it doesn't send an e-mail for each record.

[CostasM]

Rabbit, thanks, I tried but unsuccesfully. The source for my recordset is usual Access query, where I have:
1) e-mail address of Customer in order to send message
2) some fields with info for Customer to send

Now I reached composing of separate e-mail message for each RECORD, but I need separate message for each CUSTOMER with all records, where his e-mail address is the same.
like this:

objMessage.To = "[e-mail]"
objMessage.TextBody =
"record 1: Field 1, Field 2, Field 3, etc. 
 record 2: Field 1, Field 2, Field 3, etc.
 record 3: etc"
'for each above record we have the same e-mail address in a Field 3
 

Probably I need to use two recordsets, 1st for e-mail addresses and 2nd - for records to group it together for each Customer. Or two While-Loop cycles ?

What do you mean "rest of the message stuff" ?

[TheSmileyCoder]

In your implementation in your original post, you are sending an email once for each record in your recordset. Anything not related to looping through the recordset should be outside the recordset.

Private Sub btn1_SendDA_Click()
 
On Error GoTo btn1_SendDA_Click_Error
 
 Dim Rst As ADODB.Recordset
 Dim strSQL As String
 
 Set Rst = New ADODB.Recordset
 
 
    strSQL = "select * from [qryDA-REQUEST]" 'source of recordset 
    Rst.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
 
 
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Test Message"
objMessage.From = """SENDER"" <[e-mail]>"
objMessage.To = "[e-mail]"
 
 
Do While Not Rst.EOF
  objMessage.TextBody = objMessage.TextBody & rst("FieldName")
  Rst.MoveNext
Loop
'........ extracted SMTP server configuration
 
objMessage.Send
 
 
Rst.Close
 
Set Rst = Nothing
.......
 

[CostasM]

@TheSmileyCoder
Great! Now it works, I can send ALL records from recordset, to e-mail address, specified in "objMessage.To",
But How to send only few records, where e-mail address is the same. In my previous post I tried to explain what I really need.

To open additional recordset with a filter for e-mail addresses or to loop "objMessage.To" line ?

I need to group all records by the Recepient (e-mail) with the same e-mail address, then compose the message using this records specific for each Recepient i.e. to each Recepient to send definite records filtered by his e-mail address.

Many thanks for help

[TheSmileyCoder]

Well the best solution would depend a bit on your query, and what it is sorted by.

If you use the same email across several records, it sounds like your data is not properly normalized, but without your query I can't know for sure.

A quick note about your SQL:

strSQL="select * from [qryDA-REQUEST]" 'source of recordset

It can be simplified to just

strSQL="[qryDA-REQUEST]" 'source of recordset

For simplicity lets assume your query sorts by email address first, and then by whatever else you require. That way the same email will be written next to each other in the recordset.

I will also assume you have a field in your recordset containing the recipient Email, I will assume its called tx_Email.
The following is untested air code, so typos may occur.

Private Sub btn1_SendDA_Click()
 
On Error GoTo btn1_SendDA_Click_Error
 
 Dim Rst As ADODB.Recordset
 Dim strSQL As String
 dim strEmail as string
 Set Rst = New ADODB.Recordset
 
 
    strSQL = "select * from [qryDA-REQUEST]" 'source of recordset 
    Rst.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
 
do while  
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Test Message"
objMessage.From = """SENDER"" <[e-mail]>"
objMessage.To = "[e-mail]"
 
 
Do While Not Rst.EOF
    strEmail=rst!tx_Email
    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject="Test Message"
    objMessage.From="""SENDER"" <[e-mail]>"
    objMessage.To=rst!tx_Email
 
  'Add fields to email body
  Do while strEmail=rst!tx_Email
    objMessage.TextBody = objMessage.TextBody & rst("FieldName")
    rst.MoveNext
  Loop
  'Send email
  objMessage.send
  'Clear variable for next loop
  set objMessage=nothing
Loop
 
'Cleanup 
  Rst.Close
  Set Rst = Nothing
.......
 

[CostasM]

@TheSmileyCoder
Many thanks for assistance, some part of code changed as per your recomendation but not work in proper way.
You was right, my query includes "e-mail" field, but only for sending e-mail messages. All data stored in separate tables which are normalized.

For the best understanding I have posted new post "How to create/send e-mail using data from ADODB.Recordset" with a picture what we have and what we need and last code.

Thanks again for assistance

[TheSmileyCoder]

but not work in proper way.

Please remember that your screen is not visible to me, and I don't have a copy of your database or program, so I only get the information you give me.
not work in proper way can mean a million things. You need to be more specific, please. Are you getting errors? Is the mails not sending, or sending ot many, or getting stuck in a infinite loop?

I don't even have the possibility of testing the code I provide, since I don't have a similar setup.

some part of code changed as per your recomendation

Which parts? If you change parts of the code, you will ALWAYS need to provide a copy of your new code, otherwise I don't even know if it was error in my code, or the way it was implemented.

Also how many messages are you sending? The "best" approach can vary a bit depending on whether you are sending 1000 mails, or 2 mails.

Sending 1000 mails, the most important thing might be efficiency, but if your sending 2 mails, the best approach might be a KISS (Keep It Simple Stupid) approach.

[CostasM]

@TheSmileyCoder
I think now picture is visible which I posted in my previous post. As to last code, I posted it also in my separate post, but it was deleted by moderator as duplicated.
Now I can send all records from recordset but only to one e-mail address, specified in "objMessage.To"

I need to send e-mails to different Companies, and every Company should receive only records where her address is corresponded. It means the first we need to make a filter for ecach Company(e-mail), then compose one or some records depends on query, then to send the message.

Last code which I have is here :

Private Sub btn9_Click()
'
Dim rst As ADODB.Recordset
Dim strSQL As String
Dim strEmail As String
Set rst = New ADODB.Recordset
'
strSQL = "[qryDA-REQUEST]"  'source of recordset
rst.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
Do While Not rst.EOF
strEmail = rst.Fields("e-mail")
'
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = " DA REQUEST" '
objMessage.From = """SENDER"" <[e-mail]>"
objMessage.To = rst.Fields("e-mail")
'objMessage.To = Trim(Rst.Fields("CompanyName")) & "<" & Trim(Rst.Fields("e-mail")) & ">"  ' as variant
'objMessage.To = "[e-mail]"
'
'==Add fields to email body
Do While strEmail = rst.Fields("e-mail")
 objMessage.TextBody = objMessage.TextBody & rst(1)
 rst.MoveNext
Loop
'========= SMTP server configuration extracted
'Send email
objMessage.Send
'Clear variable for next loop
Set objMessage = Nothing
Loop
rst.Close
Set rst = Nothing

-
After running this code I've got :

- messages were sent, but each record was sent in separate message, instead of to be sent together
- last record in recordset has not been sent
- I have Error 3021

[zmbd]

CostasM:
Please be aware that at my work PC your pictures are not visible in the least... my IT dept. blocks all off-site file depositories and I suspect so do a majority of other companies -- they don't want us downloading a bunch of company secrets to somewhere they can't access!

So when you post an error message as you've done in the last post it would be better to state the exact message given or when you post a set of data in as in post #7, an excerpt would be in order.

thnx

[TheSmileyCoder]

As stated, you need to have the records sorted by email address. The routine is setup to loop through the records, and if the email address is the same as the previous record, it will append the information. If the email address is different, it will send the active email, and start a new one.

For the error to go away, add between lines 24 and 25:

  If rst.Eof Then Exit Do

[CostasM]

@TheSmileyCoder
After adding this line

If rst.Eof Then Exit Do

between lines 24 and 25

folowing problems are solved:

- "last record in recordset has not been sent" - ОК,
- "I have Error 3021" - no this error appeared,

but again we still have
- each record was sent in separate message, instead of to be sent together in one message.

All my records are sorted by the date and not sorted or grouped by the e-mail address, so I think we need to group it first and then send the message. My question is how to group it first and then to collect all corresponding records together in ONE message

I changed a little bit my previous picture to show my case and what I need. Hope now the picture will be visible:

[CostasM]

See picture in previous post

[TheSmileyCoder]

Well as I presume each email is independent of the other, simply sort by email first and then by date. If you do not want to modify the query, you can just modify the way it is opened for the recordset:

strSQL = "SELECT * FROM [qryDA-REQUEST] ORDER BY [E-mail], [DateField]"  'source of recordset

Sure, we can go into more complicated ways of doing it, but at present I don't see the benefit gained.

[CostasM]

Great! Thanks to all persons involved, especially to TheSmileyCoder. Now it works, I can send 1-500 messages with many records inside by clicking only one button, but faced with another problem:
-after sending numerous messages by this automatical way my SMTP provider blocked my IP address by SPAM-filter and IP address was also reputated in barracudacentral.org as "poor"

Any ideas to solve ?

[zmbd]

Ah... that's a seperate question for another thread :)
(hint, you'll need to get on the telephone...)

[TheSmileyCoder]

Sending a big load of mail will probably get you flagged as a spammer. I don't really know what the correct setup is for removing said blocking, but I suggest you talk to your ISP and your SMTP provider.