I prepared an update to that article to accommodate the input of a subject
line about a month ago, but apparently it has not gone "live" yet.

Here is the revised code:

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

   Source.Sections.First.Range.Cut

   Documents.Add

   Selection.Paste

   Set oItem = oOutlookApp.CreateItem(olMailItem)

   With oItem

       .Subject = mysubject

       .Body = ActiveDocument.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

   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