title: Adding attachment to mail merge to email
body: <p>I am trying to create a mail merge to email which also adds an attachment.  I am following a procedure outlined in the article 
  <a href="http://word.mvps.org/FAQs/MailMerge/MergeWithAttachments.html" rel="nofollow">http://word.mvps.org/FAQs/MailMerge/MergeWithAttachments.html</a></p>
  
  <p>The emails are created and sent to the correct email addresses but the attachments are not being added. I have tested it and the correct file name is being used.</p>
  
  <pre><code>Sub emailmergewithattachments()
  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")
  If Err &lt;&gt; 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
      Set oItem = oOutlookApp.CreateItem(olMailItem)
      With oItem
          .Subject = mysubject
          .Body = Source.Sections(j).Range.Text
          Set Datarange = Maillist.Tables(1).Cell(j, 1).Range
          Datarange.End = Datarange.End - 1
          .To = Datarange
          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 &amp; " messages have been sent."
  'Clean up
  Set oOutlookApp = Nothing
  End Sub
  </code></pre>