通过VBA在Outlook联系人中使用FileAs名称替换“从”，“至”，“抄送”字段

Question

我是VBA的新手，并且使用Outlook2010。这是我第二次编写代码。

当我收到电子邮件时，“发件人”字段中的姓名与我的Outlook联系人中的姓名不匹配。我搜索了网站，并找到了将“发件人”字段中的名称更改为Outlook联系人中的名称的提示。我已经从https://www.slipstick.com/developer/categorize-messages-using-contact-category/获得了代码并对其进行了修改。

“发件人”字段中的名称为MailItem.SentOnBehalfOfName，我成功将其替换为Contact中的FileAs名称。

现在，我想尝试以相同的方式更改“收件人”和“抄送”字段，将电子邮件地址与联系人匹配，并在联系人中将显示的名称替换为FileAs名称。但是，我无法在“收件人”和“抄送”字段中提取每个电子邮件地址并进行处理。

有人可以帮助我吗？

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session
  ' instantiate objects declared WithEvents
  Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
  Set objNS = Nothing
End Sub

'Use this to run the macro on a message already in the Inbox
Public Sub ContactCategoriesManual()
    Dim objMail As Object
    Set objMail = Application.ActiveExplorer.Selection.Item(1)
    olInboxItems_ItemAdd objMail
Set objMail = Nothing
End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
'To use in a run a script rule
'Sub ContactCategories(Item As MailItem)
     Dim oContact As Outlook.ContactItem
     Dim oSender


Set oSender = Item.Sender

If Not oSender Is Nothing Then

     Set oContact = oSender.GetContact
             Set oSender = Nothing

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

            Set Item = Nothing
             End If
         End If


 End Sub