recordset needed to populate all emails as string into the To:box

[sha7jpm]

ok.. this is not a "how do I email" question I promise!

I have this code which sends off multiple emails.. fine and dandy..

But...

our systems here have a virus protection which means if you are bulk emailing from access through outlook
for every email you send you get a msg saying this could be open to a virus are you sure you want to send it yes/No
have attached a screenshot..

so you have to click yes for every email you send... upto 500 times! Bah!

so.. I am trying to find a way of populating the To:Box with all the recipients before sending the email.. this way it is one email to many receipents.. not 1 email to each individual recipient..

eg. blah@blah.com; wohho@wohho.com; ding@dong.com etc etc

the code I have cycles through the addresses one by one.. is there a way to create one massive string with ";" in between?

many thanks
john.

Private Sub Command0_Click()
Dim rsEmail As DAO.Recordset
Dim strEmail As String
Set rsEmail = CurrentDb.OpenRecordset("email")

Do While Not rsEmail.EOF
strEmail = rsEmail.Fields("Email").Value
DoCmd.SendObject , , , strEmail, , , "ignore this please.. it is a test", "Message Text", False

rsEmail.MoveNext

Loop
Set rsEmail = Nothing
End Sub

 

[Mile-O]

strEmail = strEmail & rsEmail.Fields("Email") & ";"


Then, once out of the loop:

strEmail = Left(strEmail, Len(strEmail) - 1)

 

[sha7jpm]

ta!

Cheers Mile.. I really appreciate the response.. saw you had touched on the idea of this previously in another post.. so am glad you responded..

but am still getting only 1 recipient in the email..
below is the code I have adapted with your additions.. I am missing something basic here? not sure i have put the 2nd stremail command in the correct place...have tried it in different locations but no luck...

thanks again
John.

Private Sub Command0_Click()
Dim rsEmail As DAO.Recordset
Dim strEmail As String
Set rsEmail = CurrentDb.OpenRecordset("email")

Do While Not rsEmail.EOF
strEmail = strEmail & rsEmail.Fields("Email") & ";"
strEmail = Left(strEmail, Len(strEmail) - 1)
DoCmd.SendObject , , , strEmail, , , "ignore this please.. it is a test", "Message Text", True

rsEmail.MoveNext


Loop
Set rsEmail = Nothing
End Sub

 

[namliam]

Or use redemption to send mails...

Regards

 

[Mile-O]

As I said - "once out of the loop"

Do While Not rsEmail.EOF 
    strEmail = strEmail & rsEmail.Fields("Email") & ";" 
   rsEmail.MoveNext 
Loop

strEmail = Left(strEmail, Len(strEmail) - 1) 
DoCmd.SendObject , , , strEmail, , , "ignore this please.. it is a test", "Message Text", True

 

[sha7jpm]

think my brain is out of the loop!!

cheers!

not sure I can think of a witty response in latin for you..

like the new avatar though...

 

[Mile-O]

Thanks.

 

[Mile-O]

not sure I can think of a witty response in latin for you..

How about Persian then? Or Aramaic?

 

[sha7jpm]

better than my quote for sauerkraut and leiderhosen in german!

Vinum et musica laetificant cor

aramaic is pushing it too far!

 

[sha7jpm]

a gem of a website!

http://www.asterix-obelix.nl/latin-uk.htm