VBA Code - Record Auto Email Rejections

[WILTSBOY]

Hi,
I have successfully tested the following code that automatically sends emails with attachments, if required, to a list of email addresses within a spreadsheet, column A.
Before I start using this with "live" data Is there a way of highlighting rejected/non valid email addresses back to the source spreadsheet? I thought I read somewhere that the relevant cells font could be changed in colour. Or create a new worksheet with rejected email addresses? or any other suggestions would be very much appreciated.
If this option is successful, is there any way I could stop the auto email from Outlook that reports on each "Undeliverable email" each time.?

Many thanks in advance.


Sub SendMultipleEmails()</SPAN></SPAN>

Dim OutApp As Object</SPAN></SPAN>
Dim OutMail As Object</SPAN></SPAN>
Dim cell As Range</SPAN></SPAN>
Dim LastRow As Long</SPAN></SPAN>
Dim DList As String</SPAN></SPAN>

On Error Resume Next</SPAN></SPAN>
Set OutApp = GetObject(, "Outlook.Application")</SPAN></SPAN>
If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")</SPAN></SPAN>
On Error GoTo 0</SPAN></SPAN>

LastRow = Workbooks("Distribution.xls").Sheets("Email Addresses").Cells(Rows.Count, "A").End(xlUp).Row</SPAN></SPAN>
For Each cell In Workbooks("Distribution.xls").Sheets("Email Addresses").Range("A1:A" & LastRow)</SPAN></SPAN>
If DList = "" Then</SPAN></SPAN>
DList = cell.Value</SPAN></SPAN>
Else</SPAN></SPAN>
DList = DList & "; " & cell.Value</SPAN></SPAN>
End If</SPAN></SPAN>
Next cell</SPAN></SPAN>

Set OutMail = OutApp.CreateItem(0)</SPAN></SPAN>
With OutMail</SPAN></SPAN>
.To = "xxx@xxx.co.uk”</SPAN></SPAN>
.bcc = DList</SPAN></SPAN>
.Subject = "January 2016 Test Communication From WiltsBoy"</SPAN></SPAN>
.Body = "Dear User," _</SPAN></SPAN>
& vbNewLine & vbNewLine _</SPAN></SPAN>
& "Please do not reply to this email as the email address used will not accept incoming emails. The following message is for information purposes only. Hopefully it has arrived with you via an automated process and is a test for future multiple emails to our colleagues." _</SPAN></SPAN>
& vbNewLine & vbNewLine _</SPAN></SPAN>
& "Regards," _</SPAN></SPAN>
& vbNewLine & vbNewLine _</SPAN></SPAN>
& "Admin Team"</SPAN></SPAN>
.Attachments.Add ("C:\Doc's 2015\2015 Gigs\xl1.pdf")
.Send</SPAN></SPAN>
End With</SPAN></SPAN>

Set OutMail = Nothing</SPAN></SPAN>
Set OutApp = Nothing</SPAN></SPAN>

End Sub</SPAN></SPAN>