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