UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Help Splitting Batch Email Into Smaller Groups, Access 2016    
 
   
basson
post Feb 26 2018, 12:44 PM
Post#1



Posts: 873
Joined: 26-March 02
From: St.Louis, MO, USA


Hi,

I have a process which will send out one email to everyone in a distribution list, (email addresses in an Access table).

That DL is going to be expanded from about 40 address to about 600. The exchange server group at my business says they do not want me to send any one email to more than 100 addresses at once.
So I need help to figure out how to send separate emails in batches.
What I want to do is basically what I am doing now below but breaking it into loops of 100 addresses at a time per email send until the list is completely run through.
So I need help figuring out how to cut it off at 100 email addresses and send the email but also how to start the process up again for the next 100, send and so on until the list is completed.


'-------------------------------------------------------------------------------------------------
Function Email_DELAY_NOTIFICATION()


Set myOlApp = CreateObject("Outlook.Application")
Set myitem = myOlApp.CreateItem(0)

Set myAttachments = myitem.Attachments
Set MyDB = CurrentDb
Set MyEL = MyDB.OpenRecordset("DL_ALL")
MyEL.MoveFirst
Do Until MyEL.EOF
If MyEL![DELAY_NOTIFICATION] Then
DistList = DistList & MyEL![EMAIL_ADDR] & " ; "
myitem.BCC = (DistList)
End If

MyEL.MoveNext
Loop

'Email
'---------------------------------------------------------
myitem.Subject = "MY SUBJECT"

myitem.Body = "MY MESSAGE....."

Set myAttachments = myitem.Attachments
myitem.Attachments.Add "C:\MyFile.xlsx"

myitem.display

myItem.Send

'---------------------------------------------------------





Set myOlApp = Nothing
Set myitem = Nothing
Set MyEL = Nothing
Set MyDB = Nothing

End Function
'-------------------------------------------------------
Go to the top of the page
 
theDBguy
post Feb 26 2018, 12:53 PM
Post#2


Access Wiki and Forums Moderator
Posts: 73,924
Joined: 19-June 07
From: SunnySandyEggo


Hi,

Assuming all addresses are stored in the DL_ALL table, I can think of a couple of approaches to do this.

1. If you have an ID field in the table, we can divide the records into groups of 100 IDs, or

2. You can use a temporary table to store the IDs or email address as you send an email out. All subsequent emails to send out will exclude any addresses already in the temp table.

Just my 2 cents...
Go to the top of the page
 
basson
post Feb 26 2018, 03:25 PM
Post#3



Posts: 873
Joined: 26-March 02
From: St.Louis, MO, USA


I do not currently have a unique ID field on the table. I could add one but since the list is refreshed\replaced weekly, they would always be changing.
I was thinking of adding another check box field to the table, marking it as "Yes"(-1) as each address is added, then checking to make sure it is false before the next address is added in the loop so I do not add any flagged as sent.
Then I could also use this box as the exclusion the next time the email loop was triggered.
I just need to know how to stop the loop and send after adding 100 addresses, and more important, how to re-trigger the loop again to repeat until no records are left marked unsent.

If you think that would work, thoughts on my "somehow" steps below?


'-------------------------------------------------------------------------------------------------
Function Email_DELAY_NOTIFICATION()


Set myOlApp = CreateObject("Outlook.Application")
Set myitem = myOlApp.CreateItem(0)

Set myAttachments = myitem.Attachments
Set MyDB = CurrentDb
Set MyEL = MyDB.OpenRecordset("DL_ALL")
MyEL.MoveFirst
Do Until MyEL.EOF
If MyEL![DELAY_NOTIFICATION] and MyEL![EMAIL_SENT] = 0 Then
DistList = DistList & MyEL![EMAIL_ADDR] & " ; "
myitem.BCC = (DistList)
End If

'Flag as Sent
SQL = "UPDATE DL_ALL SET DL_ALL.EMAIL_SENT = -1 WHERE [DL_ALL].[Email Address] = " & "'" & MyEL![Email Address] & "'"
CurrentDb.Execute (SQL)



MyEL.MoveNext
Loop

Somehow stop adding addresses here when it gets to 100.

'Email
'---------------------------------------------------------
myitem.Subject = "MY SUBJECT"

myitem.Body = "MY MESSAGE....."

Set myAttachments = myitem.Attachments
myitem.Attachments.Add "C:\MyFile.xlsx"

myitem.display

myItem.Send

Somehow restart the loop again here to add and send the next 100 addresses.
'---------------------------------------------------------
Go to the top of the page
 
MadPiet
post Feb 26 2018, 03:30 PM
Post#4



Posts: 2,594
Joined: 27-February 09



Definitely one of those times I wish Access had the equivalent of SQL Server's ROW_NUMBER() function... Found this article that explains a lot of it. But requires a column with unique values in Access:
https://stackoverflow.com/questions/1468322...w-number-in-SQL
Go to the top of the page
 
DanielPineault
post Feb 26 2018, 03:58 PM
Post#5


UtterAccess VIP
Posts: 6,272
Joined: 30-June 11



What about something along the lines of

CODE
Function Email_DELAY_NOTIFICATION()
    'Dim your Variables!
    Dim iCounter              As Long

    Set MyEL = CurrentDb.OpenRecordset("DL_ALL")
    Do Until MyEL.EOF
        iCounter = iCounter + 1
        If MyEL![DELAY_NOTIFICATION] Then
            DistList = DistList & MyEL![EMAIL_ADDR] & "; "
        End If
        If iCounter >= 100 Then
            Call SendEmail(DistList)
            iCounter = 0 'Reset the counter
            DistList = "" 'Reset the recipient list
        End If
        MyEL.MoveNext
    Loop
    
    MyEL.Close
    Set MyEL = Nothing
End Function
  
  Function SendEmail(sBCC As stirng)
      'Dim your Variables!
      
      Set myOlApp = CreateObject("Outlook.Application")
      Set myitem = myOlApp.CreateItem(0)
  
      Set myAttachments = myitem.Attachments
      myitem.BCC = sBCC
  
      'Email
      '---------------------------------------------------------
      myitem.Subject = "MY SUBJECT"
      myitem.Body = "MY MESSAGE....."
      Set myAttachments = myitem.Attachments
      myitem.Attachments.Add "C:\MyFile.xlsx"
      myitem.display
      myitem.Send
      '---------------------------------------------------------
      Set myOlApp = Nothing
      Set myitem = Nothing
  End Function





Don't forget to properly declare/dim all your variable and add error handling.






Go to the top of the page
 
basson
post Feb 26 2018, 04:43 PM
Post#6



Posts: 873
Joined: 26-March 02
From: St.Louis, MO, USA


So you are suggesting to capture the addresses first then call the email for those. I would still need to flag them in there to filter out the sent emails before running again so I do not capture and resend to the same addresses. Also to reset the flag for the next day's run.

Go to the top of the page
 
DanielPineault
post Feb 26 2018, 04:51 PM
Post#7


UtterAccess VIP
Posts: 6,272
Joined: 30-June 11



QUOTE
So you are suggesting to capture the addresses first then call the email for those. I would still need to flag them in there to filter out the sent emails before running again so I do not capture and resend to the same addresses. Also to reset the flag for the next day's run.


iconfused.gif

The code I provided should (untested) loop through all the records of the DL_ALL table/query and build a DistList string of email addresses. Once the counter hit 100, it will then call the function to send the e-mail to the recipients and the reset the counter and DistList so as to build it for the next 100 people, and so on and so on... There is no risk of resending to the same people as you are continuously moving forward (.MoveNext) through the recordset.




As for

QUOTE
Also to reset the flag for the next day's run.


I suppose once the process is completed then you could run an update query to change your flag. Is the flag necessary? I don't know enough about your db to know. If the flag is important than the approach might need to be changed to update them after the email call and having ensured it was sent successfully.
Go to the top of the page
 
basson
post Feb 26 2018, 05:08 PM
Post#8



Posts: 873
Joined: 26-March 02
From: St.Louis, MO, USA


OK,
I did not understand the use of .MoveNext. I assumed it cleared when you hit the "Set MyEL = Nothing". I misinterpreted its position so I see now.

I have used a yes\no flag field for similar purposes in the past as a filter but it also helps me to identify where a process left off if it fails somehow mid-run.
Thanks

Go to the top of the page
 
ADezii
post Feb 26 2018, 05:21 PM
Post#9



Posts: 2,146
Joined: 4-February 07
From: USA, Florida, Delray Beach


Why not:
  1. Create a Recordset based on DL_ALL.
  2. Retrieve an accurate Count of Records in this Recordset.
  3. Use the MOD Operator to send EMails in Blocks of 100 while traversing this Recordset.
  4. The following Code will simulate this Logic. Obviously it is flawed since it will work only if the number of Records in DL_ALL is > 100 AND is in even multiples of 100 but the point is simply to illustrate how this can be done. Logic can easily be incorporated to process Records < 100 and the remaining Records past MOD 100 in DL_ALL, such as Record 47001 to 47077 (EOF).

CODE
Dim lngCtr As Long
Dim lngCtr2 As Long
Dim MyDB As DAO.Database
Dim rst As DAO.Recordset
Dim lngNumOfRecs As Long
Dim strBuild As String

Set MyDB = CurrentDb
Set rst = MyDB.OpenRecordset("DL_ALL", dbOpenSnapshot)

rst.MoveLast: rst.MoveFirst

lngNumOfRecs = rst.RecordCount

For lngCtr = 1 To lngNumOfRecs
  strBuild = strBuild & rst![Email] & ";"
    If lngCtr Mod 100 = 0 Then
      'Simulate sending the EMails
      Me![Text17] = Left$(strBuild, Len(strBuild) - 1)
        DoEvents
          strBuild = ""
    End If
    rst.MoveNext
Next

rst.Close
Set rst = Nothing

Go to the top of the page
 
DanielPineault
post Feb 26 2018, 05:29 PM
Post#10


UtterAccess VIP
Posts: 6,272
Joined: 30-June 11



In that case, as you loop through the records you can edit it to update the flag and update it.

The issue with that is that it will solely mean it was processed to be included in a batch, it will not necessarily mean the email was actually sent successfully.




Anyways, try something more like

CODE
Function Email_DELAY_NOTIFICATION()
     Dim MyEL                  As DAO.Recordset
     Dim sSQL                  As String
     Dim iCounter              As Long
     Dim DistList              As String

     On Error GoTo Error_Handler

     sSQL = "SELECT [EMAIL_ADDR], [EMAIL_SENT] " & vbCrLf & _
            "FROM DL_ALL " & vbCrLf & _
            "WHERE (([DELAY_NOTIFICATION]=True) AND ([EMAIL_SENT]=False));"
     Set MyEL = CurrentDb.OpenRecordset(sSQL)
     With MyEL
         If .RecordCount <> 0 Then
             Do Until .EOF
                 iCounter = iCounter + 1
                 'Build the list of BCC recipients
                 DistList = DistList & ![EMAIL_ADDR] & "; "
                 'Update the current record flag that it has been processed
                 .Edit
                 ![EMAIL_SENT] = True
                 .Update
                 'Check our counter and perform a send if we hit our batch size
                 If iCounter >= 100 Then
                     Call SendEmail(DistList)
                     iCounter = 0    'Reset the counter
                     DistList = ""    'Reset the recipient list
                 End If
                 .MoveNext
                 'Process the last batch in case there weren't 100 records.
                 If .EOF And i <> 0 Then
                     Call SendEmail(DistList)
                     iCounter = 0    'Reset the counter
                     DistList = ""    'Reset the recipient list
                 End If
             Loop
         End If
     End With

Error_Handler_Exit:
     On Error Resume Next
     If Not MyEL Is Nothing Then
         MyEL.Close
         Set MyEL = Nothing
     End If
     Exit Function

Error_Handler:
     MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: Email_DELAY_NOTIFICATION" & vbCrLf & _
            "Error Description: " & Err.Description & _
            Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
            , vbOKOnly + vbCritical, "An Error has Occured!"
     Resume Error_Handler_Exit
End Function
  
   Function SendEmail(sBCC As stirng)
     On Error GoTo Error_Handler
       'Dim your Variables!
       Dim myOlApp
       Dim myitem
       Dim myAttachments
      
       Set myOlApp = CreateObject("Outlook.Application")
       Set myitem = myOlApp.CreateItem(0)
       Set myAttachments = myitem.Attachments
       myitem.BCC = sBCC
  
       'Email
       '---------------------------------------------------------
       myitem.Subject = "MY SUBJECT"
       myitem.Body = "MY MESSAGE....."
       Set myAttachments = myitem.Attachments
       myitem.Attachments.Add "C:\MyFile.xlsx"
       myitem.display
       myitem.Send
       '---------------------------------------------------------

Error_Handler_Exit:
     On Error Resume Next
     If Not myAttachments Is Nothing Then Set myAttachments = Nothing
     If Not myitem Is Nothing Then Set myitem = Nothing
     If Not myOlApp Is Nothing Then Set myOlApp = Nothing
     Exit Function

Error_Handler:
     MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: SendEmail" & vbCrLf & _
            "Error Description: " & Err.Description & _
            Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
            , vbOKOnly + vbCritical, "An Error has Occured!"
     Resume Error_Handler_Exit
   End Function
Go to the top of the page
 
basson
post Apr 10 2018, 04:33 PM
Post#11



Posts: 873
Joined: 26-March 02
From: St.Louis, MO, USA



Thanks,
Getting back to this tomorrow and I'll try it out.

QUOTE
The issue with that is that it will solely mean it was processed to be included in a batch, it will not necessarily mean the email was actually sent successfully.


I guess nothing I can do about that...I have to assume the batch puts the ones then flagged in the list into the BCC and Outlook sends them. I could always open the sent email to check if a certain email address was in the BCC line if someone says they did not get the email and I have no bounceback.

Go to the top of the page
 
basson
post Apr 11 2018, 08:07 AM
Post#12



Posts: 873
Joined: 26-March 02
From: St.Louis, MO, USA


Not sure how "sBCC As stirng" works \ what \ where it references the code above it?

Go to the top of the page
 
DomFino
post Apr 26 2018, 09:03 AM
Post#13



Posts: 160
Joined: 26-July 03



I do this for my mailing list of 400 newsletters. I do it a bit different. I use Access to extract all the data and send the email to the DRAFT folder in Outlook. I then use Outlook VBA to send batches of 98 records every 25 minutes. It works great but you have to leave Outlook open until the job is complete. Once the job is complete the timer in disabled.

Access code
'This sends it to the DRAFT folder!
MyMail.Save

'Some people have asked how to see the e-mail instead of automaticially sending it.
'Uncomment the next line And comment the "MyMail.Send" or "MyMail.Save" whichever line above this is used.

'MyMail.Display

'And on to the next one...
MailList.MoveNext

Loop

'Cleanup after ourselves
Set MyMail = Nothing

'Uncomment the next line if you want Outlook to shut down when its done. Otherwise, it will stay running.

'MyOutlook.Quit
Set MyOutlook = Nothing

MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing


Outlook Code

Public Sub SendDrafts()
Dim olApp As Outlook.Application
Dim NS As Outlook.NameSpace
Dim DraftsFolder As Outlook.MAPIFolder
Dim Drafts As Outlook.Items
Dim DraftItem As Outlook.MailItem
Dim lDraftCount As Long

Set olApp = Outlook.Application
Set NS = olApp.GetNamespace("MAPI")

Set DraftsFolder = NS.GetDefaultFolder(olFolderDrafts)
Set Drafts = DraftsFolder.Items

' ********************************************************************************

'Loop through all Draft Items
lstNumber = Drafts.Count - 97
If lstNumber < 1 Then
lstNumber = 1
End If
For lDraftCount = Drafts.Count To lstNumber Step -1
Set DraftItem = Drafts.Item(lDraftCount)
'Send Item
DraftItem.DeleteAfterSubmit = True 'Don't save a copy of sent email
DraftItem.Send
Next lDraftCount

' Check Drats count for no more records to process then stop timer.
If Drafts.Count = 0 Then
MsgBox "Timer deactivated."
Call DeactivateTimer
End If

' ********************************************************************************
***
'Clean-up
Set DraftsFolder = Nothing
Set NS = Nothing
Set olApp = Nothing

End Sub
Go to the top of the page
 
DomFino
post Apr 26 2018, 09:09 AM
Post#14



Posts: 160
Joined: 26-July 03



Here is the timer start and stop code for Outlook.




Private Sub Application_Quit()

If TimerID <> 0 Then Call DeactivateTimer 'Turn off timer upon quitting **VERY IMPORTANT**

End Sub




Sub StartTimer()
'First call macro to initially send fist round of drafts
SendDrafts

MsgBox "Activating the Timer."
Call ActivateTimer(25) 'Set timer to go off every 25 minutes

End Sub
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    11th December 2018 - 01:44 AM