Requirement to break bulk emails into smaller groups for transmission (1 Viewer)

[IanO]

I have put together a VBA sub to run Outlook.Application to send a report to selected email addresses.
A Table's records contain an email addresses as well as category for grouping purposes.
I use a "Create Table Query" to extract the selected email addresses from the table into a temporary table called "ETransferAddress" then "Set rst = CurrentDb.OpenRecordset("ETransferAddress")" then concatenate the email addresses separated with commas.

This works fine for small groups, but the service provider blocks them if the number of email addresses go into the hundreds.

What I need is to break the email addresses into sub groups and then create a series of emails all with the same Report, Subject and Content.
One way might be to create a series of loops to create a number of smaller tables but to string that lot together to achieve it is beyond me at present.
This problem cannot be unique but I have spent weeks on this. Any ideas?
Here is my code to date"

    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
    Dim strPath As String
    Dim strFilter As String
    Dim strFile As String
    Dim rst As DAO.Recordset
    
'Create a table with selected addresses
'using a Create Table Query called ETransferAddress
    DoCmd.SetWarnings False
    DoCmd.OpenQuery ("ETransferAddress")
    DoCmd.SetWarnings True
    
'Look in table and concatenate email addresses
Set rst = CurrentDb.OpenRecordset("EmailCreateTable")
Do Until rst.EOF
  strEmailAddress = strEmailAddress & rst("EmailAddress") & ","
  rst.MoveNext
Loop
   strEmailAddress = Left(strEmailAddress, Len(strEmailAddress) - 1)

'Cleanup
rst.Close
Set rst = Nothing

'Replace VB Carriage return with HTML
    MessageNew = Replace(Message, vbCrLf, "<br><br>")

'Define file attachment
    strFile = ToAttach

'Start Outlook
        Set appOutLook = CreateObject("Outlook.Application")
        Set MailOutLook = appOutLook.CreateItem(olMailItem)

        With MailOutLook
            .BodyFormat = olFormatRichText
            .To = strEmailAddress
            ''.cc = ""
            ''.bcc = ""
            .Subject = Subject
            .HTMLBody = MessageNew
            .Attachments.Add (strFile)
            '.Send      'Comment out .Display if sending without displaying first
            .Display    'Comment out .Send if using this line
        End With
        Exit Sub

 

[pbaldy]

Like to send 50 at a time or something like that? Haven't needed to do it, but my first thought is to break the emailing code out to a function. Add a counter variable and increment it inside your loop. Add a test in there like:

If VariableName = 50 Then
  'call email function, passing strEmailAddress
  'strEmailAddress = ""
  'VariableName  = 0
End If

Obviously that's just an overview, but perhaps gives you a direction to go in?

 

[IanO]

Thanks Paul, will explore that idea later in the day.