[Georgea]

Hello,
I use the macro below to create and send an HTML email merge with
attachments. It references a directory that stores the To email address and
attachment link. I would like to cc 2 other people on each email and hope
someone can help me with the code. If a dialogue box simply asked who should
be cc'd, that would be fine (as long as I can enter multiple addresses).

Thanks very much!

Sub emailmergewithattachments()
'To create the email messages in HTML format
Dim source As Document, Maillist As Document, TempDoc As Document
Dim datarange As Range
Dim i As Long, j As Long
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."
' 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.
For j = 1 To source.Sections.Count
source.Sections(j).Range.Copy
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
.Subject = mysubject
.BodyFormat = olFormatHTML
.Display
Set objDoc = .GetInspector.WordEditor
Set objSel = objDoc.Windows(1).Selection
objSel.Paste
Set datarange = Maillist.Tables(1).Cell(j, 1).Range
datarange.End = datarange.End - 1
.To = datarange
For i = 2 To Maillist.Tables(1).Columns.Count
Set datarange = Maillist.Tables(1).Cell(j, i).Range
datarange.End = datarange.End - 1
.Attachments.Add Trim(datarange.Text), olByValue, 1
Next i
.Send
End With
Set oItem = Nothing
Next j
Maillist.Close wdDoNotSaveChanges
' Close Outlook if it was started by this macro.
If bStarted Then
oOutlookApp.Quit
End If
MsgBox source.Sections.Count & " messages have been sent."
'Clean up
Set oOutlookApp = Nothing
End Sub