title: Sending multiple attachments in automated email using excel
body: <p>I am hoping that someone can help.</p>
  
  <p>I have a macro in excel that looks down a column of email address and sends an individual email to those addresses with a specified attachment.
  The macro works perfectly, however I am unsure how to adapt the macro to be able to send two attachments in the same email.</p>
  
  <p>Please help.
  The full code is;</p>
  
  <pre><code>Sub Send()
  'Working in Excel 2000-2016
  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("Email")
  
  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 = cell.Offset(0, 7).Value
              .HTMLBody = "&lt;html&gt;&lt;body&gt;&lt;p&gt;Hello " &amp; cell.Offset(0, -1).Value &amp; "&lt;p&gt;&lt;/p&gt;" _
              &amp; cell.Offset(0, 2).Value &amp; "&lt;/p&gt;&lt;p&gt;" _
              &amp; cell.Offset(0, 3).Value _
              &amp; Signature &amp; "&lt;/body&gt;&lt;/html&gt;"
  
              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
              '.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>