Thanks Thanks:  0
Likes Likes:  0
Results 1 to 3 of 3

Thread: Sending Email to multiple recipients in CC

  1. #1
    Board Regular
    Join Date
    Apr 2012
    Posts
    330
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Sending Email to multiple recipients in CC

    Hello Folks ,

    I have a code which is working fine sending email to recipients mentioned in each cell in Column "C" however in Column "D" i have more than 1 recipients whom i have to keep all in CC.What changes can be done to the below code so that it can take CC recipients as well

    Code:
    Dim OutApp As Object    Dim OutMail As Object
        Dim rng As Range
        Dim Ash As Worksheet
        Dim Cws As Worksheet
        Dim Rcount As Long
        Dim Rnum As Long
        Dim FilterRange As Range
        Dim FieldNum As Integer
        Dim mailAddress As String
    
    
    
    
        On Error GoTo cleanup
        Set OutApp = CreateObject("Outlook.Application")
    
    
    
    
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
    
    
    
    
        'Set filter sheet, you can also use Sheets("MySheet")
        Set Ash = ActiveSheet
    
    
    
    
        'Set filter range and filter column (Column with names)
        Set FilterRange = Ash.Range("A1:H" & Ash.Rows.Count)
        FieldNum = 1    'Filter column = A because the filter range start in A
    
    
    
    
        'Add a worksheet for the unique list and copy the unique list in A1
        Set Cws = Worksheets.Add
        FilterRange.Columns(FieldNum).AdvancedFilter _
                Action:=xlFilterCopy, _
                CopyToRange:=Cws.Range("A1"), _
                CriteriaRange:="", Unique:=True
    
    
    
    
        'Count of the unique values + the header cell
        Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))
    
    
    
    
        'If there are unique values start the loop
        If Rcount >= 2 Then
            For Rnum = 2 To Rcount
    
    
    
    
                'Filter the FilterRange on the FieldNum column
                FilterRange.AutoFilter Field:=FieldNum, _
                                       Criteria1:=Cws.Cells(Rnum, 1).Value
    
    
    
    
                'Look for the mail address in the MailInfo worksheet
                mailAddress = ""
                On Error Resume Next
                mailAddress = Application.WorksheetFunction. _
                              VLookup(Cws.Cells(Rnum, 1).Value, _
                                    Worksheets("Sheet1").Range("A1:C" & _
                                    Worksheets("Sheet1").Rows.Count), 3, False)
                On Error GoTo 0
    
    
    
    
    
    
    
    
    On Error Resume Next
                mailAddress = Application.WorksheetFunction. _
                              VLookup(Cws.Cells(Rnum, 1).Value, _
                                    Worksheets("Sheet1").Range("A1:D" & _
                                    Worksheets("Sheet1").Rows.Count), 4, False)
                On Error GoTo 0
                
                
                
    
    
    
    
                If mailAddress <> "" Then
                    With Ash.AutoFilter.Range
                        On Error Resume Next
                        Set rng = .SpecialCells(xlCellTypeVisible)
                        On Error GoTo 0
                    End With
    
    
    
    
                    Set OutMail = OutApp.CreateItem(0)
    
    
    
    
                    On Error Resume Next
                    With OutMail
                        .To = mailAddress
                        .CC = mailAddress
                        .Subject = "Test mail"
                        .HTMLBody = RangetoHTML(rng)
                        .Send  'Or use Display
                    End With
                    On Error GoTo 0
    
    
    
    
                    Set OutMail = Nothing
                End If
    
    
    
    
                'Close AutoFilter
                Ash.AutoFilterMode = False
    
    
    
    
            Next Rnum
        End If
    
    
    
    
    cleanup:
        Set OutApp = Nothing
        Application.DisplayAlerts = False
        Cws.Delete
        Application.DisplayAlerts = True
    
    
    
    
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With

  2. #2
    Moderator mole999's Avatar
    Join Date
    Oct 2004
    Location
    UK
    Posts
    9,601
    Post Thanks / Like
    Mentioned
    15 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Sending Email to multiple recipients in CC

    You don't need both of these
    .To = mailAddress
    .CC = mailAddress

    so change the .CC one
    • Yes I know there are better ways to do it. I just wish I knew them. - 97, 2003, 2007, 2010, 2013, 2016 & 2019
    • I wear my ignorance openly, excel is not my chosen career, its a means to an ends
    • Posting Guidelines Want to post well laid out questions and answers Translate Excel Versions
      Code:
      [CODE ]Put Your Code[/ CODE]
    • Settings > General Settings (on the left) scroll to the bottom, > Miscellaneous Options > Use ENHANCED
    • X-Posting Guidelines Rule 13 > CHART STUFF

  3. #3
    Board Regular
    Join Date
    Apr 2012
    Posts
    330
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Sending Email to multiple recipients in CC

    .CC is taking only one mail id , I need the code should take all the recipients present in column D , "To" recipient is only one in column C however in from of To recipient I have 3 or more than 3 recipients in column D.

    In front of one recipient in column C , In Column D I have like this : abc.xyz.com;bcd@xyz.com;cde@xyz.com;efg@xyz.com

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •