Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

group recordset by email

Posted on 2012-08-14
12
Medium Priority
?
313 Views
Last Modified: 2012-08-14
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

0
Comment
Question by:Shawn
  • 7
  • 5
12 Comments
 
LVL 29

Expert Comment

by:IrogSinta
ID: 38294505
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
 
LVL 1

Author Comment

by:Shawn
ID: 38294627
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
 
LVL 29

Expert Comment

by:IrogSinta
ID: 38294673
Can you post the recordsource for sbfrmTranslationDetails?
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 1

Author Comment

by:Shawn
ID: 38294735
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
 
LVL 29

Expert Comment

by:IrogSinta
ID: 38294742
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
 
LVL 1

Author Comment

by:Shawn
ID: 38294872
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
 
LVL 1

Author Comment

by:Shawn
ID: 38294877
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
 
LVL 29

Expert Comment

by:IrogSinta
ID: 38294900
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
 
LVL 1

Author Comment

by:Shawn
ID: 38294909
getting no current record on the line
If rst.EOF Or strEmail <> rst!email Then
0
 
LVL 1

Author Comment

by:Shawn
ID: 38294936
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
 
LVL 29

Accepted Solution

by:
IrogSinta earned 2000 total points
ID: 38294940
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
 
LVL 1

Author Comment

by:Shawn
ID: 38294988
even better. thx again
0

Featured Post

Become an Android App Developer

Ready to kick start your career in 2018? Learn how to build an Android app in January’s Course of the Month and open the door to new opportunities.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Windows Explorer let you handle zip folders nearly as any other folder: Copy, move, change, and delete, etc. In VBA you can also handle normal files and folders, but zip folders takes a little more - and that you'll find here.
Implementing simple internal controls in the Microsoft Access application.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …

571 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question