如何使用VBA/Excel获取outlook收件人详细信息

我在Excel上有一个收件人列表（或电子邮件地址）。是否有办法使用Outlook.Application和/或Outlook.MailItem和VBA获取他们的详细信息

以下是显示收件人所在部门的功能：

Public Function Get_Department_Name(ByVal Recipient As String)
    Dim obApp As Object
    Dim NewMail As MailItem
    Set obApp = Outlook.Application
    Set NewMail = obApp.CreateItem(olMailItem)    
    With NewMail
         .Subject = "Test Subject"
         .To = Recipient
         .Body = " Body of Message "
    End With
Get_Department_Name  = NewMail.Recipients.Item(1).AddressEntry.Manager().Department

    NewMail.Delete
   Set obApp = Nothing
    Set NewMail = Nothing
End Function

然而，我没有设法得到：

1） 公司头衔，如副董事、副总裁等

---

2） 组织详细信息，如“客户服务”、“人力资源”等。

此函数使用AddressEntry.GetExchangeUser方法（Outlook）获取所需的职务/部门

---

有。如果你愿意，会有无数的结果出现。当然，您已经尝试了一些，并有一些代码向我们展示，以及对哪些有效，哪些无效的评论？在提出问题之前，你应该知道在这里需要付出一些努力。请检查。我认为您必须使用AddressEntry.GetExchangeUser方法（Outlook）。如果AddressEntry属于Exchange AddressList对象，如全局地址列表（GAL），则返回表示AddressEntry的ExchangeUser对象并对应于Exchange用户。必须连接到Exchange服务器才能使用此方法。然后可以获得'Debug.Print（oExUser.JobTitle）Debug.Print（oExUser.OfficeLocation）Debug.Print（oExUser.BusinessTelephoneNumber）'等，GetExchangeUser工作正常。谢谢你@DKK很高兴您能找到解决方案。

Public Function Get_JobTitle(ByVal Recipient As String)
    Dim obApp As Object
    Dim NewMail As MailItem

    Set obApp = Outlook.Application
    Set NewMail = obApp.CreateItem(olMailItem)
    With NewMail
         .Subject = Date & " Test Email"
         .To = Recipient
    End With

Get_JobTitle = NewMail.Recipients.Item(1).AddressEntry.GetExchangeUser.JobTitle
' Can replace JobTitle by  department
    NewMail.Delete
   Set obApp = Nothing
    Set NewMail = Nothing

End Function