Sub EmailList1A()
'Using object to create early and late binindg
'Column A holds file name
'Column B holds email address
'Column C holds path
Dim OutApp As Object
Dim OutMail As Object
Dim Cell As Range
'Switch off updating screen
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
'Create error trap
On Error GoTo cleanup
Sheets("Sheet1").Activate 'Change the sheet name if not sheet1
For Each Cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If Cell.Value Like "?*@?*.?*" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = Cell.Value
.Subject = Cells(Cell.Row, "A").Value
.body = "Please find attached file for your review\action"
.Attachment.Add Cells.Columns("C").Value & Cells.Columns("A").Value
' Once tested change the next line to .Send
.display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next Cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
