title: Attaching relevent excel file to auto-email
body: <p>I have written code to export my data by manufacturer name into new books named for the manufacturer.</p>
  
  <p>Now I have tweaked an email macro to automatically email the manufacturers.</p>
  
  <p>I'd like it to automatically attach my files from My Documents</p>
  
  <p>Here's what I have, but it attaches nothing.</p>
  
  <pre><code>Sub BacklogEmail()
  Dim subjectLine As String
  Dim bodyline As String
  Dim tb As ListObject
  Dim lineCounter As Long
  Dim myArray1, arrayCounter As Long, tempNumb As Long
  Dim nameCounter As Long
  Dim emAddress As String
  ReDim myArray1(1 To 1)
  arrayCounter = 0
  nameCounter = 1
  
  Set tb = ActiveSheet.ListObjects("Table10")
  
  
  For i = 1 To ActiveSheet.ListObjects("Table10").ListRows.Count
      emAddress = tb.DataBodyRange.Cells(i, tb.ListColumns("Email Address").Index)
      For X = LBound(myArray1) To UBound(myArray1)
          On Error Resume Next
          If emAddress = myArray1(X) Then GoTo goToNext
      Next X
          On Error GoTo 0
          subjectLine = "Obsolescence Report for Manufacturer(s)  "
          ReDim Preserve myArray1(1 To nameCounter)
          myArray1(nameCounter) = emAddress
          nameCounter = nameCounter + 1
          lineCounter = 1
              With tb.ListColumns("Email Address").Range
                  Set C = .Find(emAddress, LookIn:=xlValues)
                  If Not C Is Nothing Then
                      firstaddress = C.Address
                      Beep
                      arrayCounter = arrayCounter + 1
                      Do
                          Nrow = C.Row - 1
                          If lineCounter = 1 Then
                              subjectLine = subjectLine &amp; tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Manufacturer Name").Index)
                              lineCounter = lineCounter + 1
                             ' bodyline = "Manufacturer " &amp; tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Manufacturer Name").Index) &amp; ",  Manufacturer Item Number " &amp; tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Manufacturer Item Number").Index)
                          Else:
                              subjectLine = subjectLine
                              'bodyline = bodyline &amp; vbNewLine &amp; "Manufacturer " &amp; tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Manufacturer Name").Index) &amp; ",  Manufacturer Item Number " &amp; tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Manufacturer Item Number").Index)
                          End If
  
                          Set C = .FindNext(C)
                      Loop While Not C Is Nothing And C.Address &lt;&gt; firstaddress
                  End If
                          Run SendMailFunction(emAddress, subjectLine, bodyline)
  '                        Debug.Print vbNewLine
  '                        Debug.Print emAddress
  '                        Debug.Print "Subject: " &amp; subjectLine
  '                        Debug.Print "Body:" &amp; vbNewLine; bodyline
              End With
  goToNext:
  Next i
  Set C = Nothing
  End Sub
  
  
  
  
  Function SendMailFunction(emAddress As String, subjectLine As String, bodyline As String)
  Dim OutApp As Object
  Dim OutMail As Object
  Dim cell As Range
  Dim tb As ListObject
  Dim NL As String
  Dim DNL As String
  Dim lineCounter As Long
  Dim myArray1, arrayCounter As Long, tempNumb As Long
  Dim nameCounter As Long
  ReDim myArray1(1 To 1)
  arrayCounter = 0
  nameCounter = 1
  
  NL = vbNewLine
  DNL = vbNewLine &amp; vbNewLine
  Application.ScreenUpdating = False
  Set OutApp = CreateObject("Outlook.Application")
  Set tb = ActiveSheet.ListObjects("Table10")
  
             ReDim Preserve myArray1(1 To nameCounter)
             myArray1(nameCounter) = emAddress
             nameCounter = nameCounter + 1
             lineCounter = 1
              With tb.ListColumns("Email Address").Range
                  Set C = .Find(emAddress, LookIn:=xlValues)
                 If Not C Is Nothing Then
                      firstaddress = C.Address
                      Beep
                      arrayCounter = arrayCounter + 1
                          Nrow = C.Row - 1
                        If lineCounter = 1 Then
                        Set OutMail = OutApp.CreateItem(0)
         On Error Resume Next
          With OutMail
  
              .To = emAddress
              .Subject = subjectLine
              .Body = "Hello, attached is an excel file that we require you to complete. " &amp; _
                      "This is required by as we must know when parts are going to become obsolete. " &amp; _
                      "We appriciate your contribution to keeping our databases current. " &amp; _
                      "Thank you for your timely response."
                              .Attachments.Add "U:\\\\" &amp; tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Manufacturer Name").Index) &amp; ".xlsx"
                              lineCounter = lineCounter + 1
  
             .Display
  
  
       On Error GoTo 0
          Set OutMail = Nothing
  
  
  End With
  End If
  End If
  End With
  End Function
  </code></pre>