Обработка входящего письма в Outlook

Private Sub Application_NewMail()   ' Сравнение входящих адресатов со списком контактов и удаление письма с несуществующим адресом
On Error Resume Next    ' Защита от ошибки в it.Email1Address, когда it - не контакт, а список рассылки
Dim myFolder As Outlook.MAPIFolder
    Set myFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set myContacts = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Items
    Set newItem = myFolder.Items.GetLast
    
'    MsgBox newItem.SenderEmailAddress & Chr(10) & newItem.Subject
    
    d = True             ' Удалять!
    For Each it In myContacts
        If it.Email1Address = newItem.SenderEmailAddress Then
            d = False     ' Не удалять!
            MsgBox it.Email1Address & "=" & newItem.SenderEmailAddress
        End If
    Next it
    If d Then newItem.Delete
 
End Sub

Private Sub Application_NewMail()   ' Сравнение входящих адресатов со списком контактов и удаление письма с несуществующим адресом
On Error GoTo ErrorZone     ' Защита от ошибки в it.Email1Address, когда it - не контакт, а список рассылки
Dim myFolder As Outlook.MAPIFolder
    Set myFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set myContacts = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Items
    Set newItem = myFolder.Items.GetLast
    
    del = True              ' Удалять!
    For Each it In myContacts
        If it.Email1Address = newItem.SenderEmailAddress Then
            del = False     ' Не удалять!
        End If
Lab1:
    Next it
    
    If del Then newItem.Delete
 
Exit Sub
ErrorZone:
    GoTo Lab1
End Sub