Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Mail merge emails with attachments and formatted text problem

144 views
Skip to first unread message

neilh12

unread,
Feb 25, 2010, 12:12:07 PM2/25/10
to

Hi, first time posting here so hopefully someone can help.

I have successfully used Doug Robbins' is Mail Merge to email with
attachments at http://word.mvps.org/faqs/mailmerge/MergeWithAttachments.htm
(thanks Doug, you are a star). I'm using Word and Outlook 2003.

I'd like to though be able to retain the formatting of my text in Word to
the emails, including clickable URLs. Searching the archives found this
thread
http://www.tech-archive.net/Archive/Word/microsoft.public.word.mailmerge.fields/2009-02/msg00123.html
which I've tried, and while the revised version shown at the end of the
thread stops the last email being sent twice, what I'm finding is that the
emails are going out with the attachment, and to the correct email recipients
but blank (ie not picking up the original text at all) but rather they
include my normal Outlook signature (with links) instead!!

The signature wasn't added to the emails using the original macro (when
plain text copied over from the mail merge successfully).

Can anyone shed some light on this? It's the last bit of the puzzle I'm
looking for to get me round the email solution I'm looking for!

Thanks in advance for your help.

Neil

Doug Robbins - Word MVP

unread,
Feb 25, 2010, 2:48:46 PM2/25/10
to
Your question has come up before, and I am sure that at that time, the
following alternate code that I developed did work. More recently however
in developing the ManyToOne Mail Merge utility that can be downloaded from
fellow MVP Graham Mayor's website at I could not get it to work and came up
with a different method that is now used in that add-in. Try the following
and see if it works for you in Office 2003. Post back with the results, and
if it doesn't work, I will see about modifying it to use the later method.
A modified method may need a different approach however, which may be
dependent on the data source, so do let me know what that is if necessary:

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 = "Som...@somewhere.com; Someo...@somewhereelse.com"
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

"neilh12" <nei...@discussions.microsoft.com> wrote in message
news:927D46A6-9710-4F26...@microsoft.com...

0 new messages