How far did you get and what went wrong?

--
Peter Jamieson - Word MVP
Word MVP web site http://word.mvps.org/

In the following modification of the code, provision has been made for you
to entere the address for the cc:

Dim Source As Document, Maillist As Document
Dim Datarange As Range
Dim Counter As Integer, i As Integer
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim mysubject As String, message As String, title As String

Set Source = ActiveDocument

' Check if Outlook is running.  If it is not, start Outlook

On Error Resume Next

Set oOutlookApp = GetObject(, "Outlook.Application")

If Err <> 0 Then
   Set oOutlookApp = CreateObject("Outlook.Application")
   bStarted = True
End If

' Open the catalog mailmerge document

With Dialogs(wdDialogFileOpen)
   .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."    '
Setprompt.
title = " Email Subject Input"    ' Set title.

' Display message, title

mysubject = InputBox(message, title)

' Iterate through the rows of the catalog mailmerge document, extracting
theInformation
' to be included in each email.

Counter = 1
While Counter <= Maillist.Tables(1).Rows.Count
   Source.Sections.First.Range.Cut
   Documents.Add
   Selection.Paste
   Set oItem = oOutlookApp.CreateItem(olMailItem)
   With oItem
       .Subject = mysubject
       .Body = ActiveDocument.Content
       Set Datarange = Maillist.Tables(1).Cell(Counter, 1).Range
       Datarange.End = Datarange.End - 1
       .To = Datarange
       .CC = "" '[Enter email address to which the cc is to be sent.]
       For i = 2 To Maillist.Tables(1).Columns.Count
           Set Datarange = Maillist.Tables(1).Cell(Counter, i).Range
           Datarange.End = Datarange.End - 1
           .Attachments.Add Trim(Datarange.Text), olByValue, 1
       Next i
       .Send
   End With
   Set oItem = Nothing
   ActiveDocument.Close wdDoNotSaveChanges
   Counter = Counter + 1
Wend

'  Close Outlook if it was started by this macro.

If bStarted Then
   oOutlookApp.Quit
End If

?Clean up

Set oOutlookApp = Nothing
Source.Close wdDoNotSaveChanges