Add CC and BCC with Mail Merge

First, I would highlight your email code and the code to iterate over your spreadsheet. Here I am taking the email code for the look and feel (remember to set links -> Outlook object model, as I used an earlier suggestion)

Sub SendMessage(recipients As Variant, subject As String, body As String, Optional ccRecips As Variant, Optional bccRecips As Variant, Optional DisplayMsg As Boolean, Optional AttachmentPath As Variant)
          Dim objOutlook As Outlook.Application
          Dim objOutlookMsg As Outlook.MailItem
          Dim objOutlookRecip As Outlook.Recipient
          Dim objOutlookAttach As Outlook.Attachment
          Dim item As Variant
          ' Create the Outlook session.
          On Error Resume Next
             Set objOutlook = GetObject(, "Outlook.Application")
             If Err <> 0 Then
                 Set objOutlook = CreateObject("Outlook.Application")
             End If
          On error goto 0

          ' Create the message.
          Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

          With objOutlookMsg
              ' Add the To recipient(s) to the message.
              For Each item In recipients
                Set objOutlookRecip = .recipients.Add(item)
                objOutlookRecip.Type = olTo
              Next
              ' Add the CC recipient(s) to the message.
              If Not IsMissing(ccRecips) Then
                For Each item In ccRecips
                  Set objOutlookRecip = .recipients.Add(item)
                  objOutlookRecip.Type = olTo
                Next
              End If
             ' Add the BCC recipient(s) to the message.
              If Not IsMissing(bccRecips) Then
                For Each item In bccRecips
                  Set objOutlookRecip = .recipients.Add(item)
                  objOutlookRecip.Type = olBCC
                Next
              End If
             ' Set the Subject, Body, and Importance of the message.
             .subject = subject
             .body = body 'this can also be HTML, which is great if you want to improve the look of your email, but you must change the format to match

             ' Add attachments to the message.
             If Not IsMissing(AttachmentPath) Then
                 Set objOutlookAttach = .Attachments.Add(AttachmentPath)
             End If

             ' Resolve each Recipient name -this may not be necessary if you have fully qualified addresses.
             For Each objOutlookRecip In .recipients
                 objOutlookRecip.Resolve
             Next

             ' Should we display the message before sending?
             If DisplayMsg Then
                 .Display
             Else
                 .Save
                 .Send
             End If
          End With
          Set objOutlook = Nothing
 End Sub

      

        
        
        
      

    

Note. Recipients, CC, and BCC expect arrays of values, which can also be just one value. This means that we can perhaps send a raw range to it, or we can load that range into an array and send it to that.

Now that we've created a good generic way to send emails (which is easy to reuse), we can think about the logic of what we email. I built the following email but didn't spend a lot of time on it (or tested it as it is pretty specific to your tables). I believe it should be very close though.

While writing this, I think you will see a major trick for editing yours, however - the key was the separator text in cell CC, used by the separator. This creates an array of addresses that can then be iterated over and added to the recipient, CC, or BCC.

Sub DocumentSuperMailSenderMagicHopefully()
Dim Source As Document, Maillist As Document, TempDoc As Document
Dim mysubject As String, message As String, title As String
Dim datarange As Range 'word range I'm guessing...
Dim body As String
Dim recips As Variant
Dim ccs As Variant
Dim bccs As Variant
Dim j As Integer
Dim attachs As Variant
Set Source = ActiveDocument
With Dialogs(wdDialogFileOpen)  'Hey, I'm not sure what this does, but I'm leaving it there.
    .Show
End With
Set Maillist = ActiveDocument
' Show an input box asking the user for the subject to be inserted into the email messages
message = "Enter the subject to be used for each email message."    ' Set prompt.
title = " Email Subject Input"    ' Set title.
' Display message, title
mysubject = InputBox(message, title)
' Iterate through the Sections of the Source document and the rows of the catalog mailmerge document,
' extracting the information to be included in each email.

'IMPORTANT: This assumes your email addresses in the table are separated with commas!
For j = 0 To Source.Sections.Count - 1
    body = Source.Sections(j).Range.Text
    'get to recipients from tables col 1 (I'd prefer this in excel, it tables are much better!)
    Set datarange = Maillist.tables(1).Cell(j, 1).Range
    datarange.End = datarange.End - 1
    recips = Split(datarange.Text)
    'CC's
    Set datarange = Maillist.tables(1).Cell(j, 2).Range
    datarange.End = datarange.End - 1
    ccs = Split(datarange.Text)
    'BCC's
    Set datarange = Maillist.tables(1).Cell(j, 3).Range
    datarange.End = datarange.End - 1
    bccs = Split(datarange.Text)

    'Attachments array, should be paths, handled by the mail app, in an array
    ReDim attachs(Maillist.tables(1).Columns.Count - 3) 'minus 2 because you start i at 2 and minus one more for option base 0
    For i = 2 To Maillist.tables(1).Columns.Count
        Set datarange = Maillist.tables(1).Cell(j, i).Range
        datarange.End = datarange.End - 1
        attachs(i) = Trim(datarange.Text)
    Next i

   'call the mail sender
   SendMessage recips, subject, body, ccs, bccs, False, attachs
   Next j
Maillist.Close wdDoNotSaveChanges
MsgBox Source.Sections.Count - 1 & " messages have been sent."
End Sub

      

        
        
        
      

    

This turned into a longer post than I expected. Good luck with your project!