Sending multiple emails (1 Viewer)

ppataki

Registered User.
Local time
Today, 01:18
Joined
Sep 5, 2008
Messages
267
Dear All,

I have a query the content of which I would like to send via email
I would like each UserID to receive only their records

I have the below code but the problem is that a mail gets created for each record and not for each UserID
And the code covers the To field only, I would also need the Body to get "grouped" by UserID

Could you please advise?
Many thanks in advance

Code:
Dim rstRecip As Recordset
Set rstRecip = CurrentDb.OpenRecordset("qry_emailing", dbOpenDynaset)
With rstRecip
  Do While Not .EOF
  ToField = .Fields("UserID")
     
    Dim olapp As Object
    Dim olns As Object
    Dim olfolder As Object
    Dim olitem As Object
    Dim olattach As Object

    Set olapp = CreateObject("Outlook.Application")
    Set olns = olapp.GetNamespace("MAPI")
    Set olfolder = olns.getdefaultfolder(6)
    Set olitem = olapp.createitem(0)
    Set olattach = olitem.Attachments

    olitem.To = ToField
    'olitem.CC = ""
    olitem.Subject = "Absence approval request of "
    olitem.body = "Please find below all the requests of "
    'olattach.Add "c:\temp\cafeteria_rendszer.pdf", 1
    
    olitem.display
    'olitem.send

    Set olitem = Nothing
    Set rs = Nothing
    Set db = Nothing
    Set olfolder = Nothing
    Set olns = Nothing
    Set olapp = Nothing

.MoveNext
  Loop
End With
rstRecip.Close
Set rstRecip = Nothing
 

spikepl

Eledittingent Beliped
Local time
Today, 10:18
Joined
Nov 3, 2010
Messages
6,142
1. Dont loop around all the stuff that is common, eg olapp, and corresponding Nothings etc -that goes outside. olitem is the specific mail and stays inside the loop
2. store user id in some varable
3. make an inner loop that runs as long as the userid=your_tempvariable, and adds to .body When finished: send. Remember to check for EOF there too.
 

ppataki

Registered User.
Local time
Today, 01:18
Joined
Sep 5, 2008
Messages
267
Thank you for the reply but could you please be more specific, this is a bit out of my league
:)
 

darbid

Registered User.
Local time
Today, 10:18
Joined
Jun 26, 2008
Messages
1,428
Thank you for the reply but could you please be more specific, this is a bit out of my league
:)
what he means is something like this.

Code:
Dim olapp As Object
 Dim olns As Object
 Dim olfolder As Object
 Dim olitem As Object
 Dim olattach As Object


Set olapp = CreateObject("Outlook.Application")
Set olns = olapp.GetNamespace("MAPI")
Set olfolder = olns.getdefaultfolder(6)
 
 Do While Not .EOF
  ToField = .Fields("UserID")

    Set olitem = olapp.createitem(0)
    Set olattach = olitem.Attachments

    olitem.To = ToField
    'olitem.CC = ""
    olitem.Subject = "Absence approval request of "
    olitem.body = "Please find below all the requests of "
    'olattach.Add "c:\temp\cafeteria_rendszer.pdf", 1
    
    olitem.display
    'olitem.send

    Set olitem = Nothing
    Set olattach = Nothing
 
.MoveNext
  Loop
  
Set rs = Nothing
Set db = Nothing
Set olfolder = Nothing
Set olns = Nothing
Set olapp = Nothing
 

darbid

Registered User.
Local time
Today, 10:18
Joined
Jun 26, 2008
Messages
1,428
I have the below code but the problem is that a mail gets created for each record and not for each UserID

What is "qry_emailing"

Then what you are going to need to do is group your Recordset by UserID and then keep adding records to your email object until the UserID changes.

If you do this then do not forget that you cannot have this in the loop UNTIL you have a new UserID

Code:
Set olitem = Nothing     
Set olattach = Nothing
 

ppataki

Registered User.
Local time
Today, 01:18
Joined
Sep 5, 2008
Messages
267
"qry_emailing" contains the following recordset:
qry_emailing UserID Username HolidayDate Status StatusMan ManActionDate bekesikr Bekesi Krisztina 2011.05.20. Szabadság/Holiday Elbírálás alatt/Pending approval 2011.05.24. bekesikr Bekesi Krisztina 2011.05.13. Szabadság/Holiday Elbírálás alatt/Pending approval 2011.05.24. u565873 Pataki Peter 2011.05.30. Szabadság/Holiday Elbírálás alatt/Pending approval 2011.05.24. u565873 Pataki Peter 2011.05.27. Szabadság/Holiday Elbírálás alatt/Pending approval 2011.05.24.
what I would like to achieve is that the first two records are sent to userID bekesikr and the last 2 rows are sent to userID u565873

Could you please advise?

Many thanks
 

darbid

Registered User.
Local time
Today, 10:18
Joined
Jun 26, 2008
Messages
1,428
So in sudo code in your loop you will create an if - if userID = bekesikr then ........

The last 2 rows of a recordset probably would need you to keep a count of the number records in the record set and your current position. Then when you loop gets to "total recordset count - 2" you would then start the email again.
 

ppataki

Registered User.
Local time
Today, 01:18
Joined
Sep 5, 2008
Messages
267
Somehow that would need to be automated as this is a dynamic recordset that may contain dozens of records of multiple names
I think somehow the outer loop should be grouped but I have no idea how
 

darbid

Registered User.
Local time
Today, 10:18
Joined
Jun 26, 2008
Messages
1,428
Have a try at the loop part, then if you cannot get it post your try and we will have something to work with.
 

ppataki

Registered User.
Local time
Today, 01:18
Joined
Sep 5, 2008
Messages
267
Code:
If MsgBox("Biztos vagy benne?/Are you sure?", vbYesNo + vbQuestion) = vbYes Then
     
    Dim olapp As Object
    Dim olns As Object
    Dim olfolder As Object
    Dim olitem As Object
    Dim olattach As Object
    
        Dim rstRecip As Recordset
        Set rstRecip = CurrentDb.OpenRecordset("qry_emailing", dbOpenDynaset)
        With rstRecip
        Do While Not .EOF
        ToField = .Fields("UserID")

    Set olapp = CreateObject("Outlook.Application")
    Set olns = olapp.GetNamespace("MAPI")
    Set olfolder = olns.getdefaultfolder(6)
    Set olitem = olapp.createitem(0)
    Set olattach = olitem.Attachments
        
    olitem.To = ToField
    'olitem.CC = ""
    olitem.Subject = "Absence approval request of "
    olitem.body = "Please find below all the requests of "
    'olattach.Add "c:\temp\cafeteria_rendszer.pdf", 1
    
    olitem.display
    'olitem.send

    Set olitem = Nothing
    Set rs = Nothing
    Set db = Nothing
    Set olfolder = Nothing
    Set olns = Nothing
    Set olapp = Nothing
        
   
        .MoveNext
        Loop
        End With
        rstRecip.Close
        Set rstRecip = Nothing

Else
Exit Sub
End If

and the problem is that an email gets created for each record
I would like to create as many emails as many different userIDs I have in the recordset
and then paste the whole records in the email

Many thanks in advance
 

spikepl

Eledittingent Beliped
Local time
Today, 10:18
Joined
Nov 3, 2010
Messages
6,142
To "Group" here is simply make sure that your record set contains the userID's in sequence, so all mails to the same user appear together -sort on USerID in the query and you are all set.

Make your code, so that it works, sending each email for each record, ignoring any groupings. Once that works, modify the code:
1. Have a variable myNewID, and set it to 0 at the begining, before mailing anything.
2. When you get UserID from the recordset, copy it in some variable - myNewID.
If myNewId<>UserID Then
'new ID, so we need to SEND the mail with data collected so far
myNewID=UserID ' so now we can check if wer are still on same ID or not, in next round of the loop
'and here we set up the new email but do not send it until we collected all data
Else
'here we collect data from the new email record and add it to the current mail (because it is still same USerID, as in previous round), and we don't send anything
End if
 

spikepl

Eledittingent Beliped
Local time
Today, 10:18
Joined
Nov 3, 2010
Messages
6,142
And please indent your code properly
 

spikepl

Eledittingent Beliped
Local time
Today, 10:18
Joined
Nov 3, 2010
Messages
6,142
To indent code : select the lines you wish to move left or right, and press TAB (to indent right) or SHIFT TAB, to indent left
 

ppataki

Registered User.
Local time
Today, 01:18
Joined
Sep 5, 2008
Messages
267
OK, I got a bit forward
I have replaced the whole code, the new looks like this

Code:
Dim dbs As DAO.Database
    Dim strsql As String
    Dim rs As DAO.Recordset
    Set dbs = CurrentDb
    strsql = "qry_emailing_id"
    Set rs = CurrentDb.OpenRecordset(strsql)
    Do While Not rs.EOF
        CurrentDb.QueryDefs("qry_emailing").SQL = Replace(CurrentDb.QueryDefs("qry_emailingtemplate").SQL, "insert", rs!UserID)
        Dim rs2 As Recordset
        Set rs2 = CurrentDb.OpenRecordset("qry_emailing", dbOpenDynaset)
            With rs2
            Do While Not .EOF
            mailbody = mailbody & !UserID & "|" & !Username & "|" & !HolidayDate & "|" & !Status & "|" & !StatusMan & "|" & !ManActionDate & vbCrLf
            .MoveNext
            Loop
            End With
            rs2.Close
            Set rs2 = Nothing
        DoCmd.SendObject acSendNoObject, , , rs!UserID, , , "SUBJECT", mailbody
        rs.MoveNext
        Loop
        rs.Close
        Set rs = Nothing

When I run it, the first email is correct
but the second one just seems to ignore the settings and contains all the records instead of only containing the records of the second user

Any hints please?
Many thanks
 

spikepl

Eledittingent Beliped
Local time
Today, 10:18
Joined
Nov 3, 2010
Messages
6,142
There is no need to make things complex - you should break your needs into small steps and code thereafter - since you did receive an algorithm. Now here is some aircode (done in a text editor, sorry about the indents) - not tested:

Code:
Dim dbs As DAO.Database
    Dim strsql As String
    Dim rs As DAO.Recordset
    DIm myNewID as Long
    Set dbs = CurrentDb
    strsql = "qry_emailing_id"
    Set rs = CurrentDb.OpenRecordset(strsql)
    
    myNewID=0
    With rs
    Do While Not .EOF

        if myNewID<>!UserID Then 'we hit a new mail
           If myNewID<>0 then  'we hit a new mail that is NOT the first one
                DoCmd.SendObject acSendNoObject, , , rs!UserID, , , "SUBJECT", mailbody
           End If
                 'here close the old email object - the ol-Something thinggy, and its body, as in your code elsewhere
                 'and here make a new email object and body, and then add message to the body
                  mailbody =  !UserID & "|" & !Username  & "|" & !HolidayDate & "|" & !Status & "|" &  !StatusMan & "|" & !ManActionDate & vbCrLf

            Else 
               'just add to existing email object 
            mailbody = mailbody & !UserID & "|" & !Username & "|" & !HolidayDate & "|" & !Status & "|" & !StatusMan & "|" & !ManActionDate & vbCrLf
        End if
 
        .MoveNext
     Loop
     'check if there is an unsent mail (the last one)
     if mailbody<>"" then
    DoCmd.SendObject acSendNoObject, , , rs!UserID, , , "SUBJECT", mailbody
     end if
    ' here close the email and body objects
     .Close
     End with
     Set rs = Nothing
Note: the above hinges on the query listing the mails belonging to the same UserID together ! That's why the query must sort the data on UserID
 
Last edited:

ppataki

Registered User.
Local time
Today, 01:18
Joined
Sep 5, 2008
Messages
267
Unfortunately nothing happens if I run the code
(I have sorted the query by UserID)
 

Users who are viewing this thread

Top Bottom