[Jo]

I have tried to embed a word doc in an email merge doc. However, if I send
the email as an HTML, I cannot open the embedded document. Please help

[Doug Robbins - Word MVP]

See the article "Mail Merge to E-mail with Attachments" at

http://word.mvps.org/FAQs/MailMerge/...ttachments.htm

And, if you want the email to be sent as HTML, instead of the code in the
above article, use:

Sub emailmergewithattachments()



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 Object

Dim ID 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



' Iterate through the rows of the catalog mailmerge document, extracting the
information

' 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 = ActiveDocument.MailEnvelope.Item

With oItem

Set Datarange = Maillist.Tables(1).Cell(Counter, 2).Range

Datarange.End = Datarange.End - 1

.Subject = Datarange

.Body = ActiveDocument.Content

Set Datarange = Maillist.Tables(1).Cell(Counter, 1).Range

Datarange.End = Datarange.End - 1

.To = Datarange

For i = 3 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

.Save

ID = .EntryID

End With

Set oItem = Nothing

Set oItem = oOutlookApp.Session.GetItemFromId(ID)

oItemSend

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

Maillist.Close wdDoNotSaveChanges



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

"JO" wrote in message
...
I have tried to embed a word doc in an email merge doc. However, if I send
the email as an HTML, I cannot open the embedded document. Please help

[Doug Robbins - Word MVP]

There was an error in the code that I gave you. It should be:

Sub emailmergewithattachments()

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 Object
Dim ID 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

' Iterate through the rows of the catalog mailmerge document,
' extracting the information 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 = ActiveDocument.MailEnvelope.Item
With oItem
Set Datarange = Maillist.Tables(1).Cell(Counter, 2).Range
Datarange.End = Datarange.End - 1
.Subject = Datarange
.Body = ActiveDocument.Content
Set Datarange = Maillist.Tables(1).Cell(Counter, 1).Range
Datarange.End = Datarange.End - 1
.To = Datarange
For i = 3 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
.Save
ID = .EntryID
End With
Set oItem = Nothing
Set oItem = oOutlookApp.Session.GetItemFromId(ID)
oItem.Send
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
Maillist.Close wdDoNotSaveChanges

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

"JO" wrote in message
...
I have tried to embed a word doc in an email merge doc. However, if I send
the email as an HTML, I cannot open the embedded document. Please help