group recordset by email

The code below sends out 1 email per line in the recordset. So right now it sends out multiple emails to the same person if they have more than one order.

How could I group by the email and only send out one email per person and their respective orders?


Dim strEmail As String
Dim strMailSubject As String
Dim strMSG As String


Dim db As Database
Dim rst As Recordset

Set db = CurrentDb
Set rst = [sbfrmTranslationDetails].Form.RecordsetClone

With rst
        .MoveFirst
    Do Until .EOF
        If Not IsNull(rst("contactID_traducteur")) Then
        If rst("POSent") <> True Then
        If IsNull(rst("email")) Then
        MsgBox rst("FName") & ". There is no email for this record !", vbQuestion + vbOKOnly, "Informations"
        Else
        If IsEmailAddress(rst("email")) = False Then
        MsgBox rst("email") & ". This is not a valid email. Please correct !", vbQuestion + vbOKOnly, "Informations"
        Else
        strEmail = rst("email")
        strMailSubject = "new order"
        strMSG = "hi, you have a new order"
        DoCmd.SendObject to:=strEmail, Subject:=strMailSubject, MessageText:=strMSG
        End If
        End If
        End If
        End If
        .MoveNext
        
    Loop
    .Close
End With
Set rst = Nothing

Open in new window

LVL 1
ShawnAsked:
Who is Participating?
 
IrogSintaCommented:
How about this:
Dim strEmail As String, strMailSubject As String, strMSG As String, strMSGDetail As String, strSQL As String
Dim readyToSend As Boolean

Dim db As Database
Dim rst As Recordset
    
    Set db = CurrentDb
    strSQL = "Select * From qrytrad_commandes_details WHERE trad_commandesID = " & Me.trad_commandesID & "AND Not(Isnull(contactID_traducteur))" & _
    "AND POSent <> True ORDER BY email"
    Set rst = db.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)

    With rst
        .MoveFirst
        Do Until .EOF
            If IsNull(rst!email) Then
                MsgBox rst!FName & ". There is no email for this record !", vbQuestion + vbOKOnly, "Informations"
            ElseIf IsEmailAddress(rst!email) = False Then
                MsgBox rst!email & ". This is not a valid email. Please correct !", vbQuestion + vbOKOnly, "Informations"
            Else
                strEmail = rst!email
                strMSGDetail = strMSGDetail & rst!descriptif & vbCrLf
            End If
            .MoveNext
            If rst.EOF Then
                readyToSend = True
            ElseIf strEmail <> rst!email Then
                readyToSend = True
            End If
            
            If readyToSend Then
                strMailSubject = "new order"
                strMSG = "hi, you have a new order" & vbCrLf & vbCrLf & strMSGDetail
                DoCmd.SendObject to:=strEmail, Subject:=strMailSubject, MessageText:=strMSG
                
                readyToSend = False
                strMSGDetail = ""
            End If
        Loop
        .Close
    End With
    Set rst = Nothing

Open in new window

0
 
IrogSintaCommented:
Try this:
    Dim strEmail As String, strPreviousEmail As String
    Dim strMailSubject As String
    Dim strMSG As String
    
    
    Dim db As Database
    Dim rst As Recordset
    
    Set db = CurrentDb
    Set rst = [sbfrmTranslationDetails].Form.RecordsetClone
    
    With rst
        .MoveFirst
        Do Until .EOF
            If Not IsNull(rst("contactID_traducteur")) Then
                If rst("POSent") <> True Then
                    If IsNull(rst("email")) Then
                        MsgBox rst("FName") & ". There is no email for this record !", vbQuestion + vbOKOnly, "Informations"
                    ElseIf IsEmailAddress(rst("email")) = False Then
                        MsgBox rst("email") & ". This is not a valid email. Please correct !", vbQuestion + vbOKOnly, "Informations"
                    Else
                        strEmail = rst("email")
                        If strEmail <> strPreviousEmail Then
                            strMailSubject = "new order"
                            strMSG = "hi, you have a new order"
                            DoCmd.SendObject to:=strEmail, Subject:=strMailSubject, MessageText:=strMSG
                            strPreviousEmail = strEmail
                        End If
                    End If
                End If
            End If
            .MoveNext
        Loop
        .Close
    End With
    Set rst = Nothing

Open in new window

0
 
ShawnAuthor Commented:
looks like it would work if the Recordset is not sorted by email...which isn't the case right now
:(

I'm sure it can be done with the recordset but am pretty rusty. any ideas?
0
Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

 
IrogSintaCommented:
Can you post the recordsource for sbfrmTranslationDetails?
0
 
ShawnAuthor Commented:
the recordsource is a saved query and needs to keep the orderby it has (which isn't by email). I suppose I could just do a select query for the recordset. I need to pop out for about an hour but will have a go and get back.
0
 
IrogSintaCommented:
Well if you go with the select query, use Distinct.  That way you don't need to do a comparison of the current email with the previous email.
0
 
ShawnAuthor Commented:
ok, I got the code below to work. The only thing is I can't get the message detail (strMSGDetail ) to cumulate properly.

eg if there are 3 orders: apples, oranges, bananas
and only 2 emails: john@company1.com (who gets apples and oranges) and sue@company2.com (who gets bananas)
I need apples, oranges in one email and bananas in the other.

Dim strEmail As String, strPreviousEmail As String
Dim strMailSubject As String
Dim strMSG As String
Dim strMSGDetail As String
Dim strSQL As String

Dim db As Database
Dim rst As Recordset

Set db = CurrentDb
strSQL = "Select * From qrytrad_commandes_details WHERE trad_commandesID = " & Me.trad_commandesID & "AND Not(Isnull(contactID_traducteur))" & _
"AND POSent <> True ORDER BY email"
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)

With rst
        .MoveFirst
        Do Until .EOF
            If Not IsNull(rst("contactID_traducteur")) Then
                If rst("POSent") <> True Then
                    If IsNull(rst("email")) Then
                        MsgBox rst("FName") & ". There is no email for this record !", vbQuestion + vbOKOnly, "Informations"
                    ElseIf IsEmailAddress(rst("email")) = False Then
                        MsgBox rst("email") & ". This is not a valid email. Please correct !", vbQuestion + vbOKOnly, "Informations"
                    Else
                        strEmail = rst("email")
                        strMSGDetail = strMSGDetail & rst("descriptif") & vbCrLf
                        MsgBox strMSGDetail
                        If strEmail <> strPreviousEmail Then
                            
                            strMailSubject = "new order"
                            strMSG = "hi, you have a new order" & vbCrLf & vbCrLf & strMSGDetail
                            DoCmd.SendObject to:=strEmail, Subject:=strMailSubject, MessageText:=strMSG
                            strPreviousEmail = strEmail
                        End If
                    End If
                End If
            End If
            .MoveNext
        Loop
        .Close
    End With
    Set rst = Nothing

Open in new window

0
 
ShawnAuthor Commented:
ok, I get why this is not happening. It sends the email right after it finds a different email. It doesn't wait until all the detail is added.

so how do we do that?
0
 
IrogSintaCommented:
Try it this way:
Dim strEmail As String
Dim strMailSubject As String
Dim strMSG As String
Dim strMSGDetail As String
Dim strSQL As String

Dim db As Database
Dim rst As Recordset
    
    Set db = CurrentDb
    strSQL = "Select * From qrytrad_commandes_details WHERE trad_commandesID = " & Me.trad_commandesID & "AND Not(Isnull(contactID_traducteur))" & _
    "AND POSent <> True ORDER BY email"
    Set rst = db.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)

    With rst
        .MoveFirst
        Do Until .EOF
            If IsNull(rst!email) Then
                MsgBox rst!FName & ". There is no email for this record !", vbQuestion + vbOKOnly, "Informations"
            ElseIf IsEmailAddress(rst!email) = False Then
                MsgBox rst!email & ". This is not a valid email. Please correct !", vbQuestion + vbOKOnly, "Informations"
            Else
                strEmail = rst!email
                strMSGDetail = strMSGDetail & rst!descriptif & vbCrLf
            End If
            .MoveNext
            If rst.EOF Or strEmail <> rst!email Then
                strMailSubject = "new order"
                strMSG = "hi, you have a new order" & vbCrLf & vbCrLf & strMSGDetail
                DoCmd.SendObject to:=strEmail, Subject:=strMailSubject, MessageText:=strMSG
                
                strMSGDetail = ""
            End If
        Loop
        .Close
    End With
    Set rst = Nothing

Open in new window

0
 
ShawnAuthor Commented:
getting no current record on the line
If rst.EOF Or strEmail <> rst!email Then
0
 
ShawnAuthor Commented:
got it! had to split EOF and the rst!email

THANK YOU. I've been scratching my head for far too long. :)

            If rst.EOF = True Then
                strMailSubject = "new order"
                strMSG = "hi, you have a new order" & vbCrLf & vbCrLf & strMSGDetail
                DoCmd.SendObject to:=strEmail, Subject:=strMailSubject, MessageText:=strMSG

                strMSGDetail = ""
            Else
            If strEmail <> rst!email Then
                strMailSubject = "new order"
                strMSG = "hi, you have a new order" & vbCrLf & vbCrLf & strMSGDetail
                DoCmd.SendObject to:=strEmail, Subject:=strMailSubject, MessageText:=strMSG

                strMSGDetail = ""
            End If
            End If

Open in new window

0
 
ShawnAuthor Commented:
even better. thx again
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.