Adding email sent status to Excel - vba

Question

I use Excel to send monthly statements to our brokers. Is there a way to add a column to show if each of the individual email is actually sent.
Some of the rows might have an invalid email address and the only way I can tell if all of them are sent is by going through my sent folder.
Sub SendEmails()
Dim answer As Variant
answer = MsgBox("You are about to send the statements. Proceed?", vbYesNo + vbQuestion, "Alert")
Select Case answer
Case vbYes
MsgBox "Process may take a while to finish. Do not attempt to close the worksheet or Outlook.", vbInformation, "Alert"
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("Listing")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("D").Cells.SpecialCells(xlCellTypeConstants)
Set rng = sh.Cells(cell.Row, 1).Range("A1:B1")
If cell.Value Like "?*#?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Statement of Account - " & cell.Offset(0, 2).Value
.Body = cell.Offset(0, 1).Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Case vbNo
GoTo Quit:
End Select
Quit:
End Sub

Answer 1

Why not just Resolve each Recipient's email before sending
eg:
For Each olRecip In .Recipients
olRecip.Resolve
If Not olRecip.Resolve Then
olMsg.Display
End If