VBA - Outlook Multiple Emails

[keayow]

Hi all, quite new to VBA and always directed to this forum every time i google a question!

I've followed the code on - Mail a different file(s) to each person in a range
It's working as I want it to but one drawback.

- I need it to send emails to two or more people in the one email. the code provided only has one

e.g
email 1: to: x@mrexcel.com;y@mrexcel.com;z@mrexcel.com
email 2: to: a@mrexcel.com;b@mrexcel.com
email 3: to: 1@mrexcelc.om:2@mrexcel.com

Can anyone provide a modified code?

Sub Send_Files()
[COLOR=black]'Working in Excel 2000-2016
'For Tips see: [URL]http://www.rondebruin.nl/win/winmail/Outlook/tips.htm[/URL][/COLOR]
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("Sheet1")

    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

        [COLOR=black]'Enter the path/file names in the C:Z column in each row[/COLOR]
        Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .to = cell.Value
                .Subject = "Testfile"
                .Body = "Hi " & cell.Offset(0, -1).Value

                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell

                .Send  [COLOR=black]'Or use .Display[/COLOR]
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

thanks

 

[burnstripe]

Hi, on initial look the code looks to be able to handle multiple emails
instead of listing just one email in the cell have you tried adding something like this to the cell

patrick@hotmail.com;susan@hotmail.com

separating each additional email address with ;

If this still doesn't work let me know and I will take a deeper look

Thanks

 

[keayow]

it worked! can't believe i didn't think of that

thanks