E-mail Multiple Attachments

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.

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

--
Regards Ron de Bruin
http://www.rondebruin.nl


"STEVEB" <[email protected]> wrote in message
news:[email protected]...
>
> 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.
>
>
> --
> STEVEB
> ------------------------------------------------------------------------
> STEVEB's Profile: http://www.excelforum.com/member.php...fo&userid=1872
> View this thread: http://www.excelforum.com/showthread...hreadid=489979
>

Thanks Ron,

Everything worked great!