CODEWITHSUNDEEP
vbaexcelemailoutlook
Aman Devrath
Aman Devrath

Reputation: 406

multiple recipients in email but send mail through loop

For i = LBound(reviewer_names) To UBound(reviewer_names)
        reviwer_strg = reviewer_names(i)
        assigned_to_strg = assigned_to_names(LBound(assigned_to_names))
        For j = 6 To 15
            st1 = ThisWorkbook.Sheets("Master").Range("H" & j).Value
            If (reviwer_strg = st1) Then
                reviewer_email_id = ThisWorkbook.Sheets("Master").Range("I" & j).Value
                Set olMail = olApp.CreateItem(olMailItem)
                olMail.To = reviewer_email_id
                olMail.Recipients.Add (reviewer_email_id)
                olMail.Subject = "Task for Review;" & client_name & ";" & title
                str1 = "Dear " & reviewer & ", " & "<br>" & "Please see the following for review." & "<br>"
                str2 = "Task : " & title & "<br>" & "Client Name : " & client_name & "<br>" & "Due Date : " & due_date & "<br><br>"

                str3 = "Document Location : " & "<a href=""" & document_location & """>" & document_location & "</a>" & "<br>"

                str4 = "Backup Location : " & "<a href=""" & backup_location & """>" & backup_location & "</a>" & "<br><br>"
                str5 = "Awaiting your Feedback." & "<br>" & "Regards, " & "<br>" & assigned_to_strg
                olMail.HTMLBody = "<BODY style=font-size:10pt;font-family:Verdana>" & str1 & str2 & str3 & str4 & str5 & "</BODY>"
                olMail.Send
            End If
        Next
    Next i

I am sending emails by extracting email-ids from a column in excel, by comparing the names entered in a cell.

Cells from where I am extracting the names.

"Assigned to" and "Reviewer" Columns which is used to compare the names entered in the cells and the names in the columns. from this I am picking up the corresponding email id and sending mail.

The emails that I am sending are through loops. Hence everytime a mail is sent, the olMail.To picks up a single email id, and sends email to all the reviewers it matches in the column. But the recipients shows only the email id of the current recipient. I want to show all the email ids to which the email is sent, but send emails to each reviewer. ( Like mail to multiple addresses). The problem is that if I add all the email ids that are matched, in olMail.To, it gives me an error since it cannot contain more than one email id at a time. How to do it?

Upvotes: 0

Views: 932

Answers (3)

ASH
ASH

Reputation: 20302

Please look at the example below. I think this will do all you want, and more.

Make a list in Sheets("Sheet1") with :

In column A : Names of the people
In column B : E-mail addresses
In column C:Z : Filenames like this C:\Data\Book2.xls (don't have to be Excel files)

The Macro will loop through each row in "Sheet1" and if there is a E-mail address in column B and file name(s) in column C:Z it will create a mail with this information and send it.

Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    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)

        'Enter the path/file names in the C:Z column in each row
        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  'Or use .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

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

See the link below for more details.

https://www.rondebruin.nl/win/s1/outlook/amail6.htm

Upvotes: 0

Aman Devrath
Aman Devrath

Reputation: 406

This is the solution code in case someone needs it :

For i = LBound(reviewer_names) To UBound(reviewer_names) - 1
        reviwer_strg = reviewer_names(i)
        assigned_to_strg = assigned_to_names(LBound(assigned_to_names))
        For j = 6 To 15
            st1 = ThisWorkbook.Sheets("Master").Range("H" & j).Value
            If (reviwer_strg = st1) Then
                reviewer_email_id = ThisWorkbook.Sheets("Master").Range("I" & j).Value
                Set olMail = olApp.CreateItem(olMailItem)

                olMail.Subject = "Task for Review;" & client_name & ";" & title
                str1 = "Dear " & reviewer & ", " & "<br>" & "Please see the following for review." & "<br>"
                str2 = "Task : " & title & "<br>" & "Client Name : " & client_name & "<br>" & "Due Date : " & due_date & "<br><br>"
                str3 = "Document Location : " & "<a href=""" & document_location & """>" & document_location & "</a>" & "<br>"
                str4 = "Backup Location : " & "<a href=""" & backup_location & """>" & backup_location & "</a>" & "<br><br>"
                str5 = "Awaiting your Feedback." & "<br>" & "Regards, " & "<br>" & assigned_to_strg
                olMail.HTMLBody = "<BODY style=font-size:10pt;font-family:Verdana>" & str1 & str2 & str3 & str4 & str5 & "</BODY>"

                For x = LBound(reviewer_names) To UBound(reviewer_names)
                    recipient_strg = reviewer_names(x)
                    Debug.Print x & reviewer_names(x)
                    For y = 6 To 15
                        st2 = ThisWorkbook.Sheets("Master").Range("H" & y).Value
                        If (recipient_strg = st2) Then
                            recipient_email_id = ThisWorkbook.Sheets("Master").Range("I" & y).Value
                            olMail.Recipients.Add (recipient_email_id)
                        End If
                    Next y
                Next x
              olMail.Send
            End If
        Next
    Next i
    MsgBox ("Email has been sent !!!")
End If

Upvotes: 0

ashleedawg
ashleedawg

Reputation: 21629

It's a good idea to review the documentation for any procedures you're using with which you aren't completely familiar.

The To property returns or sets a semicolon-delimited String list of display names for the To recipients for the Outlook item. This property contains the display names only. The To property corresponds to the MAPI property PidTagDisplayTo. The Recipients collection should be used to modify this property.

(Source)

The Recipients collection contains a collection of Recipient objects for an Outlook item. Use the Add method to create a new Recipient object and add it to the Recipients object.

(Source)

Example:

ToAddress = "[email protected]"
ToAddress1 = "[email protected]"
ToAddress2 = "[email protected]"
MessageSubject = "It works!."
Set ol = CreateObject("Outlook.Application")
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.RecipIents.Add(ToAddress)
newMail.RecipIents.Add(ToAddress1)
newMail.RecipIents.Add(ToAddress2)
newMail.Send

(Source)

Upvotes: 1

Related Questions