E-mail Multiple Attachments

[STEVEB]

Hi All,

I am having trouble figuring out how to E-mail multiple attahcments:

The code works fine when I E-mail one attachment per E-mail address.
However it does not when I try & add another file path.

I reference a cell that has the file path for the attachment ( I use
this because the dates change automatically in the file path name) For
example Cell E2 (C:Book2_December 1.xls)

Below is the code I am using:

Sub SendWithAttach()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range

Application.DisplayAlerts = False

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In
Sheets("Mail").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Offset(0, 1).Value <> "" Then
If cell.Value Like "?*@?*.?*" And Dir(cell.Offset(0,
3).Value) <> "" Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
..To = cell.Value
..CC = cell.Offset(0, 1).Value
..Subject = cell.Offset(0, 2).Value
..HTMLBody = "Hello " & cell.Offset(0, -1).Value &
"," & SheetToHTML(ThisWorkbook.Sheets(10))
..Attachments.Add cell.Offset(0, 3).Value '&
cell.Offset(0, 5).Value
'.Display
..Send
End With
Set OutMail = Nothing
End If
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

Sheets("Mail").Select
Range("H1").Select


End Sub



Any help would be greatly appreciated.

 

[Ron de Bruin]

Hi STEVEB

Repeat this line

Attachments.Add cell.Offset(0, 3).Value
Attachments.Add cell.Offset(0, 4).Value
Attachments.Add cell.Offset(0,5).Value

 

[STEVEB]

Thanks Ron,

Everything worked great!