Ошибка в коде, касающемся замены поля «От», «Кому», «CC» именем FileAs в Outlook Contact

Question

Я сделал некоторый код, чтобы заменить поля «От», «Кому», «CC» на имя FileAs в Outlook Contact.Так как я не разбираюсь в кодировании, я искал похожий код в Интернете и смешал код.

Возникла проблема, с которой я столкнулся:

1) Когда я выбираю несколько писем в Outlook изапустите код ContactCategoriesManual(), он работает хорошо.Тем не менее, если запрос выбора в списке, код останавливается и отображается сообщение об ошибке.Есть ли способ распознать только электронную почту при выборе и запустить код без сообщения об ошибке?

2) Когда Outlook получает несколько электронных писем, в коде появляется сообщение об ошибке, и некоторая кнопка «выйти» «отладка»выскочил.Когда я нажимаю «отладка», выделяется нижняя строка.

If Item.SenderEmailType = "SMTP" Then

Когда я проверял новые электронные письма, все они были SMTP.Я не знаю, почему это не работает и отображать сообщение об ошибке.Странно то, что если я запускаю код ContactCategoriesManual() для новых писем, он работает хорошо.

Кто-нибудь может мне помочь, пожалуйста?

Option Explicit
Private WithEvents olInboxItems As Outlook.Items
Private Sub Application_Startup()
  Dim outlookApp As Outlook.Application
  Dim objectNS As Outlook.NameSpace

  Set outlookApp = Outlook.Application
  Set objectNS = outlookApp.GetNamespace("MAPI")
  Set olInboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub


Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
    Dim oContact As Outlook.ContactItem
    Dim oSender As String
    Dim folContacts As Outlook.MAPIFolder
    Dim colItems As Outlook.Items
    Dim oNS As Outlook.NameSpace
     
Set oNS = Application.GetNamespace("MAPI")
Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
Set colItems = folContacts.Items



If Item.SenderEmailType = "SMTP" Then
    oSender = Item.SenderEmailAddress
    Else
    If Item.SenderEmailType = "EX" Then
        oSender = Item.Sender.GetExchangeUser.PrimarySmtpAddress
    End If
End If


If Not (oSender = vbNullString) Then

     Set oContact = colItems.Find("[Email1Address] = '" & oSender & "' or [Email2Address] = '" & oSender & "' or [Email3Address] = '" & oSender & "'")

             oSender = vbNullString

             If Not oContact Is Nothing Then
                 Item.SentOnBehalfOfName = oContact.FileAs
                 Set oContact = Nothing
                 Item.Save
             Else
          
             End If
             Set Item = Nothing
End If

Set folContacts = Nothing
Set colItems = Nothing
Set oNS = Nothing

End Sub


Public Sub ContactCategoriesManual()
    Dim objMail As Object

    For Each objMail In Application.ActiveExplorer.Selection
        olInboxItems_ItemAdd objMail
    Set objMail = Nothing
    Next

End Sub