Email query

[scubadiver007]

Hello all,

What is the best way to send a single email to multiple recipients?

Thanks in advance

 

[pr2-eugin]

Lookup on DoCmd.SendObject method..

 

[leo.clifton]

Hello

I'm assuming that you are familiar with the code required to send the email itself through an Outlook application. Therefore, the method I would use would be to combine the separate email addresses in a single string and then use this following the 'To', separating each entry with a semicolon ( as this what Outlook recognizes as a separator. Error checks are normally required with this procedure due to a number of issues (Outlook not being open, user refusing to allow access to outlook etc.) but I haven't put them in as you will need to decide on those procedures yourself:

Sub EmailstoFriends()
Dim Friends As String
Friends = "John@hotmail.com"
Friends = Friends & ";" & "Joe@hotmail.com"
Friends = Friends & ";" & "Jane@hotmail.com"
Friends = Friends & ";" & "Joyce@hotmail.com"
Call SendEmails(Friends)
End Sub

Sub SendEmails(Recipients As String)
Dim myOlApp As Outlook.Application
Dim Refmail As Outlook.MailItem
Set myOlApp = CreateObject("Outlook.Application")
Set Refmail = myOlApp.CreateItem(olMailItem)
With Refmail
.To = Recipients
.Display
.Body = "Hello my friends"
.Subject = "A friendly message"
End With
Set myOlApp = Nothing
Set Refmail = Nothing
End Sub

 

[scubadiver007]

Sorry, wrong question means wrong answer.

I have put the emails into table A using the semi-colon so I can send emails.

I've now deicded I want to try to include information from table B associated with each record in table A in the body of the email which isn't so easy.

Thanks

 

[leo.clifton]

Ah I see. Well this shouldn't be too difficult but it depends on how you are handling the data at the moment. Is there one piece of data in table B which relates to the recipient in A? Here's an example which uses two recordsets and a couple of loops to run through the data, if there are more than one field to link to in table b it becomes a bit more complicated (the code assumes that you have records in both sets, otherwise you'd need a statement to check for empty tables):


Sub SendMails
Dim DB As Database
Dim RecordSetA As DAO.Recordset
Dim RecordSetB As DAO.Recordset
Dim TotalRecordsA as Integer
Dim TotalRecordsB as Integer
Dim CurrentRecordA as Integer
Dim CurrentRecordB as Integer
Set DB = CurrentDB
Set RecordSetA = DB.OpenRecordset("TableA", dbOpenDynaset)
Set RecordSetB = DB.OpenRecordset("TableB", dbOpenDynaset)
RecordSetA.MoveLast
TotalRecordsA = RecordSetA.RecordCount
RecordSetA.MoveFirst
RecordSetB.MoveLast
TotalRecordsB = RecordSetB.RecordCount
RecordSetB.MoveFirst
For CurrentRecordA = 1 to TotalRecordsA
For CurrentRecordB = 1 to TotalRecordsB
If RecordsetA.Fields("Key") = RecordSetB.Fields("Key") then
Call SendEmails(RecordsetA.Fields("EmailAddress"),RecordSetB.Fields("Content"))
End If
RecordSetB.MoveNext
Next CurrentRecordB
RecordSetA.MoveNext
Next CurrentRecordA
RecordSetA.Close
RecordSetB.Close
Set RecordSetA = Nothing
Set RecordSetB = Nothing
Set DB = Nothing
End Sub

Sub SendEmails(Recipient As String, Content as String)
Dim myOlApp As Outlook.Application
Dim Refmail As Outlook.MailItem
Set myOlApp = CreateObject("Outlook.Application")
Set Refmail = myOlApp.CreateItem(olMailItem)
With Refmail
.To = Recipient
.Display
.Body = Content
.Subject = "A friendly message"
End With
Set myOlApp = Nothing
Set Refmail = Nothing
End Sub

Hope this helps. There may well be better ways of going about it (which I'd be interested to hear).

 

[leo.clifton]

Just remembered that a find first function would work a lot quicker here than running through all the records, not going to write the whole thing out again but:


For CurrentRecordA = 1 to TotalRecordsA
RecordSetB.FindFirst "[Key] =" & RecordSetA.Fields("Key")
Call SendEmails(RecordsetA.Fields("EmailAddress"),RecordSetB.Fields("Content"))
RecordSetA.MoveNext
Next CurrentRecord A

Would need to also remove the section on finding total records in B as no longer needed.

 

[scubadiver007]

Hello, my situation is straightforward.

So what the code is supposed to do is loop through "qry_reminderemail" and use the KCode field to filter and save "submissions_reminder".

Then send "submission_reminder" using the email address in "qry_reminderemail", but how do I get the email address into sendobject?

Dim email As String
Dim Kcode As String
Dim mySQL As String
 
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
    StrSql = "Select * from Qry_reminderemail"
 
    Set db = CurrentDb()
    Set rs = db.OpenRecordset(StrSql)
    rs.MoveFirst
 
    Do While Not rs.EOF
 
        mySQL = "SELECT Tble_Remainingsubmissions.Service FROM tble_practice " & _
                "INNER JOIN Tble_Remainingsubmissions ON tble_practice.KCode = Tble_Remainingsubmissions.KCode " & _
                "WHERE Tble_Remainingsubmissions.KCode= '" & rs("KCode") & "' ;"
        db.QueryDefs("SUBMISSION_Reminder").SQL = mySQL
 
    DoCmd.SendObject acSendQuery, "submission_reminder", acFormatXLS, "email address", , , "blah", "blah", , False
 
    rs.MoveNext
    Loop

 

[leo.clifton]

Sorry, not up on SQL in VBA

 

[michaeljryan78]

Hello, my situation is straightforward.

So what the code is supposed to do is loop through "qry_reminderemail" and use the KCode field to filter and save "submissions_reminder".

Then send "submission_reminder" using the email address in "qry_reminderemail", but how do I get the email address into sendobject?

Dim email As String
Dim Kcode As String
Dim mySQL As String
 
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
    StrSql = "Select * from Qry_reminderemail"
 
    Set db = CurrentDb()
    Set rs = db.OpenRecordset(StrSql)
    rs.MoveFirst
 
    Do While Not rs.EOF
 
        mySQL = "SELECT Tble_Remainingsubmissions.Service FROM tble_practice " & _
                "INNER JOIN Tble_Remainingsubmissions ON tble_practice.KCode = Tble_Remainingsubmissions.KCode " & _
                "WHERE Tble_Remainingsubmissions.KCode= '" & rs("KCode") & "' ;"
        db.QueryDefs("SUBMISSION_Reminder").SQL = mySQL
 
    DoCmd.SendObject acSendQuery, "submission_reminder", acFormatXLS, "email address", , , "blah", "blah", , False
 
    rs.MoveNext
    Loop

You COULD use

DoCmd.SendObject acSendQuery, "submission_reminder", acFormatXLS, rs!EmailAddress, , , "blah", "blah", , False

 

[scubadiver007]

Hello Michael,

I was thinking the same and I assume it is as simple as this?

    DoCmd.SendObject acSendQuery, "submission_reminder", acFormatTXT, rs!email, , , "reminder", "blah", , False

I get an error:

"Microsoft Access can't save the output data to the file you've selected"

 

[michaeljryan78]

You may want to breakpoint the code and look at the variable mySQL. debug.print sends it to the immediate window. I think there is a quoting issue there.

        mySQL = "SELECT Tble_Remainingsubmissions.Service FROM tble_practice " & _
                "INNER JOIN Tble_Remainingsubmissions ON tble_practice.KCode = Tble_Remainingsubmissions.KCode " & _
                "WHERE Tble_Remainingsubmissions.KCode= '" & rs("KCode") & "' ;"

maybe:

        mySQL = "SELECT Tble_Remainingsubmissions.Service FROM tble_practice " & _
                "INNER JOIN Tble_Remainingsubmissions ON tble_practice.KCode = Tble_Remainingsubmissions.KCode " & _
                "WHERE Tble_Remainingsubmissions.KCode= '" & rs!KCode & "';"

when I am builing an SQL string in VBA I use a quote function to get around the single quotes for a variable string by using:

Function quote(str As Variant) As String
    If IsNull(str) Then
        quote = "null"
    Else
        quote = """" & Replace(Trim(str), """", "'") & """"
    End If
End Function

you can paste that in a new module. so,

mySQL = "SELECT Tble_Remainingsubmissions.Service FROM tble_practice " & _
                "INNER JOIN Tble_Remainingsubmissions ON tble_practice.KCode = Tble_Remainingsubmissions.KCode " & _
                "WHERE Tble_Remainingsubmissions.KCode= " & quote(rs!KCode) & " ; "

 

[scubadiver007]

There is nothing wrong with the SQL.

 

[michaeljryan78]

Is it failing on the send line? You have to wrap the rs!email in quotes since you are passing a string.

DoCmd.SendObject acSendQuery, "submission_reminder", acFormatXLS, "'" & rs!rs!email & "'", , , "blah", "blah", , False

 

[scubadiver007]

Sorry, I didn't make it clear what the error was referring to but I am still getting the error using

"'" & rs!email & "'"

I've noticed that I had one too many commas at the end so I am a bit further, but now I also have the Outlook message box and the error says recipients are unrecognised.



I also have this code which allows me to send emails without having the Outlook message box. I may have to ponder this.

    Set objOutlook = CreateObject("Outlook.application")
    Set objEmail = objOutlook.CreateItem(olMailItem)
    
    
    
    With objEmail
        .To = email
        .Subject = Kcode & " - Submission reminder"
        .Body = "Hello," & vbCrLf & vbCrLf & "Please be aware that you still have outstanding submissions." & vbCrLf & vbCrLf & "Regards,"
        On Error Resume Next
        .send
    End With

 

[michaeljryan78]

Are the values in rs!email correct? did you try to view the contents of the field in the immediate window just to see if there was a typo in one of the addresses? I have lots of those

 

[scubadiver007]

Hello,

I took the quote marks out and the email now appears in the outbox so it is not being sent. Also, it is in my old email account which isn't ideal.

If I use the code below (and now added CC) it works from my current account but how can I put records into the body of the email

    With objEmail
        .To = email
        .CC = "[EMAIL="example@emailaddress.com"]example@emailaddress.com[/EMAIL]"
        .Subject = Kcode & " - Submission reminder"
        .Body = "Hello," & vbCrLf & vbCrLf & "Please be aware that you still have outstanding submissions." & vbCrLf & vbCrLf & "Regards"
        On Error Resume Next
        .send
    End With

I think I'm getting closer...

 

[scubadiver007]

Any possibility of including an attachment or such in the above code otherwise I can leave it.

 

[pr2-eugin]

Just add the last line like..

    With objEmail
        .To = email
        .CC = "example@emailaddress.com"
        .Subject = Kcode & " - Submission reminder"
        .Body = "Hello," & vbCrLf & vbCrLf & "Please be aware that you still have outstanding submissions." & vbCrLf & vbCrLf & "Regards"
        [COLOR=Red][B].Attachments.Add[/B][/COLOR] [COLOR=Blue]"H:\PathTo\FileName.ext"[/COLOR]
        On Error Resume Next
        .send
    End With

 

[scubadiver007]

I want to either insert or attach records directly from the database into the email.

 

[pr2-eugin]

So before Sending the email, export the records using DoCmd.OutputTo.. Then add the Path of the exported object as attachment..