title: Email a single attachment from folder of files each to a different person
body: <p>I have a folder with 50 files and I have a list of 50 email addresses. Each file goes to a different email address. Is there a way to write a macro that performs this task?</p>
  
  <p>The problem with the set of code below is two-fold:
  1) I have 3 COLUMNS of data in an Excel file: One for subject, one for email address to send to, and the third for the FILE PATH of where the attachment to be attached is stored.</p>
  
  <p>The code below does not allow for a pre-determined set of subject arguments. It also uses ROWS?? for the filepath field instead of a column like it does for send to? So confusing.</p>
  
  <pre><code>Sub Send_Files()
      Dim OutApp As Object
      Dim OutMail As Object
      Dim sh As Worksheet
      Dim cell As Range
      Dim FileCell As Range
      Dim rng As Range
  
      With Application
          .EnableEvents = False
          .ScreenUpdating = False
      End With
  
      Set sh = Sheets("Sheet1")
  
      Set OutApp = CreateObject("Outlook.Application")
  
      For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
  
          'Enter the path/file names in the C:Z column in each row
          Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
  
          If cell.Value Like "?*@?*.?*" And _
             Application.WorksheetFunction.CountA(rng) &gt; 0 Then
              Set OutMail = OutApp.CreateItem(0)
  
              With OutMail
                  .to = cell.Value
                  .Subject = "Testfile"
                  .Body = "Hi " &amp; cell.Offset(0, -1).Value
  
                  For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                      If Trim(FileCell) &lt;&gt; "" Then
                          If Dir(FileCell.Value) &lt;&gt; "" Then
                              .Attachments.Add FileCell.Value
                          End If
                      End If
                  Next FileCell
  
                  .Send  'Or use .Display
              End With
  
              Set OutMail = Nothing
          End If
      Next cell
  
      Set OutApp = Nothing
      With Application
          .EnableEvents = True
          .ScreenUpdating = True
      End With
  End Sub
  </code></pre>