使用 Excel VBA 捕获 Outlook 地址答案

【问题标题】：Capturing Outlook address with Excel VBA使用 Excel VBA 捕获 Outlook 地址
【发布时间】：2021-08-04 06:09:27
【问题描述】：

我在 Excel 中有一个自定义 VBA 函数，它应该获取关联的 Office 用户的电子邮件地址。它对某些用户任意触发 - 有时有效，有时无效。

我的最终用户并非都使用最新版本的 Excel，但这是唯一会导致问题的 VBA 函数。对于受影响的用户，它往往在他们第一次打开文件时工作得更多，然后在随后的打开时变得惰性。

Function UserName() As String
    Dim OL As Object, olAllUsers As Object, oExchUser As Object, oentry As Object, myitem As Object
    Dim User As String
    
    Set OL = CreateObject("outlook.application")
    Set olAllUsers = OL.Session.AddressLists.Item("All Users").AddressEntries
    
    User = OL.Session.CurrentUser.Name
    
    Set oentry = olAllUsers.Item(User)
    
    Set oExchUser = oentry.GetExchangeUser()
    
    UserName = oExchUser.PrimarySmtpAddress
    
End Function

我尝试了一些来自网络的解决方案，但无济于事，并试图强制单元格重新计算，但似乎对于受影响的用户，一旦该函数决定它不做任何事情，重新计算就无关紧要了。

【问题讨论】：

我的猜测是您的代码正在访问全局地址列表。它一直有问题，但要进行故障排除，您可以在无法检索用户电子邮件地址的机器上打开 Outlook 并打开全局地址列表。在所有用户中搜索该用户的电子邮件地址。将其与成功运行的机器进行比较。也许您可以使用 GAL 中的另一个条目（不是所有用户）。
我建议向 AD 查询，而不是假设 Outlook 可以解析地址，因为您已经看到它不可靠。
您将如何构建该查询？

标签： excel vba outlook

【解决方案1】：

代码可以简化一点：

Function UserName() As String
Dim OL As Object, oExchUser As Object, oentry As Object, myitem As Object
Dim User As String

Set OL = CreateObject("outlook.application")

'
' use NameSpace.Logon if required
'

Set oentry = OL.Session.CurrentUser.AddressEntry

'
' here you can also check whether it is an Exchange account
'

Set oExchUser = oentry.GetExchangeUser()

UserName = oExchUser.PrimarySmtpAddress

End Function

【讨论】：