[Holly]

Thank you! It works great!

"Doug Robbins - Word MVP" wrote:

If you want to use the CC option with different CC's for each email, insert
the CC email address in a the second column and use the following modified
code:

Sub emailmergewithattachments()
'To create the email messages in
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")
'oOutlookApp.DefaultProfileName
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 - 1
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
Set DataRange = Maillist.Tables(1).Cell(j, 2).Range
DataRange.End = DataRange.End - 1
.cc = DataRange
For i = 3 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 - 1 & " messages have been sent."

'Clean up
Set oOutlookApp = Nothing

End Sub


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com
"Holly" wrote in message
...
Thanks Doug,

If I want to use the CC option do I need to add another column to the
directory or how does that work? The CC's will be different for each
email.
But it definately works putting everyone on the To line.

Thanks a lot, by the way. The macro is very helpful!
Holly

"Doug Robbins - Word MVP" wrote:

No problem. I had just included that to show how it could be done.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com
"Holly" wrote in message
...
Thank you, sir! I took out the cc line though.

"Doug Robbins - Word MVP" wrote:

This modified macro will send the mail merge in HTML Format so that
features
such as the table in your document will be retained:

Sub emailmergewithattachments()
'To create the email messages in
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")
'oOutlookApp.DefaultProfileName
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 - 1
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
.cc = ; "
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 - 1 & " messages have been sent."

'Clean up
Set oOutlookApp = Nothing

End Sub


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com
"Holly" wrote in message
...
Hi everyone. I got Doug Robbins' email merge with attachment macro
to
work
and realized using the merged directory would trick Outlook into
sending
the
email to more than one person. However, when I run the macro to
send
the
email I lose the Word table that I merged from an Excel spreadsheet.
All
the
information is there, it's just not in a nice table. It also
changed
my
font.

Any ideas or is this too confusing to understand?
Thanks!
Holly

.


.


.