Re: Complex e-mail merge with unique attachment

Tech-Archive recommends: Speed Up your PC by fixing your registry

From: Doug Robbins - Word MVP (dkr_at_NOmvpsSPAM.org)
Date: 05/14/04 

Date: Fri, 14 May 2004 15:05:46 +1000

As I understand it, you want the body of the email message to convey the
same message to each recipient while and individual attachment goes to each.

If the text that you want to be included in the body of the email message is
included in the ActiveDocument, when you run this modified version of the
macro at http://word.mvps.org/FAQs/MailMerge/MergeWithAttachments.htm (which
is I assume to what you are referring), it should do what you want. Of
course, in this case, the only mailmerge that you need to execute is the
catalog or directory type merge.

Sub emailmergewithattachments()

'Modified so that the body of the email message is the same for all
recipients.

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." ' Set
prompt.
title = " Email Subject Input" ' Set title.

' Display message, title

mysubject = InputBox(message, title)

' 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
    Set oItem = oOutlookApp.CreateItem(olMailItem)
    With oItem
        .Subject = mysubject
        .Body = Source.Content
        Set Datarange = Maillist.Tables(1).Cell(Counter, 1).Range
        Datarange.End = Datarange.End - 1
        .To = Datarange
        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
    Counter = Counter + 1
Wend
Source.Close wdDoNotSaveChanges

' Close Outlook if it was started by this macro.

If bStarted Then
    oOutlookApp.Quit
End If

End Sub 

-- 
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested.  Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.
Hope this helps
Doug Robbins - Word MVP
"Lana" <anonymous@discussions.microsoft.com> wrote in message
news:7011FD44-3D12-4161-A50B-460B1C0C522F@microsoft.com...
> I used the 'send as attachment' feature of the Word 'merge to e-mail'
function to send unique mailmerged memos via e-mail (to maintain formatting,
including letterhead), but didn't know how to do it with additional text in
the actual e-mail.  Some recipients were leery of opening an unexplained
attachment so I needed to include a short message within the e-mails
themselves by way of explanation.  Is there a simple way to do that (maybe
with INCLUDETEXT or something)?  I printed the emailmergewithattachments()
macro, but don't know how to get the unique results of the first mailmerge
included in the Word mailmerge catalogue (i.e., <<Attachment1>> or
<<Attachment2>>).  If I could accomplish that, it may provide the solution.
The mailmerged memos contain unique codes specific to each participant and
MUST be sent only to the appropriate people.  Suggestions?
Quantcast