Email multiple emails at once with macro/VBA

[Jyggalag]

Hi all,

I currently have the following setup:

The macro will send out an email to the 1st contact and BCC with this VBA code:

Option Explicit

Private Const FilePath As String = "\\COMPANY.MSAD.COMPANY.NET\userdata\t865934\home\Documents\TESTfolder\"
Sub send_email_complete()
Dim OutApp As Object
    Dim OutMail As Object
    Dim i As Long
    Dim ws As Worksheet
  
    '~~> Change this to the relevant worksheet
    '~~> that has the emails (right now Sheet1 has it)
    Set ws = ThisWorkbook.Sheets("Sheet1")

    Set OutApp = CreateObject("Outlook.Application")
  
    '~~> Looping from rows 2 to 10 (update if necessary)
    For i = 2 To 10
        '~~> This creates a new email (so we can send out multiple emails)
        Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = ws.Cells(i, 15).Value2
.BCC = ws.Cells(i, 18).Value2
.Subject = ws.Cells(i, 13).Value2
.HTMLBody = "Dear all,<br/>" & "<BR>" & _
"Bunch of insignificant text" & "<BR>" & _
"Kind regards</br>" & "<BR>"
.Attachments.Add FilePath & ws.Cells(2, 19).Value2

.Display

End With
Next i

End Sub

However, I would like to send out bulk emails to the 1st, 2nd and 3rd contact in one email. Is this possible?
In the case above, that would mean a total of 10 emails to 30 recipients.

Hope it makes sense, would really appreciate some help!!

Kind regards,
Jyggalag

 

[Siddharth Rout]

The .To field accepts emails separated by a colon. Is this what you are trying?

 .To = ws.Cells(i, 15).Value2 & ";" & ws.Cells(i, 16).Value2 & ";" & ws.Cells(i, 17).Value2

 

[Jyggalag]

The .To field accepts emails separated by a colon. Is this what you are trying?

 .To = ws.Cells(i, 15).Value2 & ";" & ws.Cells(i, 16).Value2 & ";" & ws.Cells(i, 17).Value2

You make life too easy for me sir :D

Thank you so much!! You're incredible, you've really given me an easy day haha - really appreciated!!!