如何使用excel vba从oulook通讯录中的Initials字段中获取信息

Question

亲爱的Stackoverflow社区，

我是业务员，并认为自己是精打细算的excel-vba，以便使办公室中的某些任务自动化。

但是，当我进行“编码”时，我偶然发现了这个问题，即我无法使用vba从Outlook通讯簿中检索“首字母缩写”字段中所述的信息。当您单击Outlook通讯簿中的条目时，将出现一个弹出窗口，其中包含用户信息。使用vba，我可以轻松访问除Initials字段之外的所有字段。（这是带有红色AddressBookInformationJohnDoe指示的字段的窗口。）

[我写的一个Skript，提取了我公司一名员工的信息，并将其复制到该员工姓名旁边的单元格中。 （请参阅下面的简化代码。明显不起作用的代码被注释掉并以问号结尾。）

Dim olApp           As Outlook.Application
Dim olNS            As Outlook.Namespace
Dim olRecip         As Outlook.Recipient

Dim Cell            As Range
Dim NameEmpl        As String
Dim Company         As String
Dim Initials        As String

NameEmpl = LCase(Trim(ActiveCell.Value))

Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")

Set olRecip = olNS.CreateRecipient(NameEmpl)
olRecip.Resolve

Company = olRecip.AddressEntry.GetExchangeUser.CompanyName
'Initials = olRecip.AddressEntry.GetExchangeUser.Initials ?

    ActiveCell.Offset(0, 1).Value = Company
    'ActiveCell.Offset(0, 2).Value = Initials ?

End Sub

但是，在GetExchangeUser中，我找不到用于缩写字段的对象。还有其他提取信息的方法吗？

我在这个论坛上看到过类似的问题，但是不能完全遵循建议的答案。因此，我谨问，如果你们中的任何人知道答案并可以向业余爱好者解释它。

非常感谢。问候，

提问者

Answer 1

只需提取名字和姓氏的首字母：

set eu = olRecip.AddressEntry.GetExchangeUser
Company = eu.CompanyName
initials = ""
if Len(eu.FirstName) > 0 Then initials = Mid(eu.FirstName, 1, 1)
if Len(eu.LastName)  > 0 Then initials = initials & Mid(eu.LastName, 1, 1)
MsgBox initials