How to insert a field into the subject line as can be one in the word document?

[colincurious]

A colleague has helped me to produce a mailmerge by linking a word 2003
document to a spreadsheet. Fields from a column in the spreadsheet can
be inserted into the document. However, I would ideally like to insert
a field into the subject line when the document is emailed to all the
recipients, otherwise a number of emails may be received that look like
duplicates. Any ideas how this can be done?

Incidentally, if an email address is typed in wrong into the
spreadsheet, I am forced into my outlook contacts area when the email
merge happens, can it be prevented from doing so to make sure I can not
risk sending the information to anyone in my outlook contacts?

Cheers
Colin

 

[Doug Robbins - Word MVP]

This modification of the code in the article "Mail Merge to E-mail with
Attachments" at

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

picks up the subject for each email message from the second column of the
catalog mailmerge document that needs to be created for the mailmerge to
email with attachments to work. The field that contains the subjects must
of course be the second field in the catalog mailmerge main document.

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 Outlook.MailItem
Dim mysubject As Range

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 = oOutlookApp.CreateItem(olMailItem)
With oItem
Set mysubject = Maillist.Tables(1).Cell(Counter, 2).Range
mysubject.End = mysubject.End - 1
.Subject = mysubject
.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
.Importance = olImportanceHigh
.ReadReceiptRequested = True
.Send
End With
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