send file to a group of Outlook contacts

I have a list of about 1000 customers, to whom I want to send a PDF file by email (Outlook).

I do this by sending the mail to myself, and I put the customers in Bcc.

Because 1000 is too much to handle, I want the customers separated in groups of 50, resulting in 20 similar mails to send.

Can anyone help me to program this in VBA ?

Thanks in advance.

The easiest way would be to loop through all customers and send the same email to each one, with the PDF attached

Not you sending each email but your VBA code handling that for you.

I can help you with that, if that's the way you want to proceed?

Thanks Croweater, but it needs to be in BCC. Otherwise I end up with having 1000 emails in the Sent folder...

Even if these 1000 can probably also be deleted automatically.

OK...here is some code for you to try.
I stress that it is only tested with a handful of emails (for obvious reasons), however I am happy to help you implementing the code if you have problems.

Public sTo As String
Public sBCC As String
Private Sub CommandButton1_Click()

    Dim ocell As Range
    Dim Count As Long
    
If MsgBox("Are you sure you want to continue with the email?" _
    , vbYesNo, "NewCopy") = vbNo Then Exit Sub
    
    
sTo = Range("MyEmail").Value
sBCC = ""

For Each ocell In Range("EmailAddresses")
    
    ' loop for all non blank email addresses
        If ocell.Value <> vbNullString Then
                               
            Count = Count + 1
            sBCC = sBCC & ocell.Value & ";"
        
            If Count = 50 Then

                Call CopyandMail
                Count = 0
                sBCC = ""
            End If
        End If
Next ocell
If Count > 0 Then
    Call CopyandMail
End If

End Sub

Sub CopyandMail()

    Dim OutApp As Object
    Dim OutMail As Object


    On Error Resume Next
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

   'Copy the Checked Sheets to a new workbook for each email addressee.
        
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

  
        On Error Resume Next
        With OutMail
            .to = sTo
            .CC = ""
            .BCC = sBCC
            .Subject = Range("EmailSubject").Value
            .Body = Range("EmailMessage").Value
            .Attachments.Add Range("EmailFile").Value
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send   'or use .Display
            '.Display
            'Application.Wait (Now + TimeValue("0:00:02"))
            'Application.SendKeys "%s"

        End With

    Set OutMail = Nothing
    Set OutApp = Nothing
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub

Hi Croweater

as promised I get back to you.

Here is how I solved the issue:

- first I count the total number of email addresses
- then I start a second incremental counter, which goes through the total list of email addresses
- each time this counter reaches 50, 100, etcetera then a draft mail is created.
- I loop until the counter reaches 1000.
This solved my problem. Thanks anyway for your help.

Th

Thanks Croweater

at first glance, this seems to be a good solution ! I'll test it out after the Easter weekend and I will get back to you.

Happy Easter !

OK Ali !

I'm new to this forum.

Thanks for your advice !

Sounds like you didn't need me in the first place. Thanks for wasting my time.

Basically, your solution included a "Counter" and this was the needed step towards the alternative solution I developed. So it was of great help. Thanks again.