在vba的Outlook通讯录中从部门获取主要的smtp邮件

问题描述

我已经搜索了很长时间，这个周末我找到了一个解决方案，但不幸的是，一个未保存的工作簿使我的结果失去了空间，我似乎再也找不到该职位了...。

我通过以下示例代码实现了名称解析：

Function MailSuchen(strSuchen As String)
    Dim objEmpfaenger As Outlook.Recipient
    Dim objExchBenutzer As Outlook.ExchangeUser
    Dim objExchListe As Outlook.ExchangeDistributionList
    
    Set objEmpfaenger = Outlook.Application.Session.CreateRecipient(strSuchen)
    objEmpfaenger.Resolve
    
    If objEmpfaenger.Resolved Then
        Select Case objEmpfaenger.AddressEntry.AddressEntryUserType
            Case OlAddressEntryUserType.olExchangeUserAddressEntry
                Set objExchBenutzer = objEmpfaenger.AddressEntry.GetExchangeUser
                If Not (objExchBenutzer Is Nothing) Then
                    MailSuchen = objExchBenutzer.PrimarySmtpAddress
                    Exit Function
                End If
            Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
                Set objExchListe = objEmpfaenger.AddressEntry.GetExchangeDistributionList
                If Not (objExchListe Is Nothing) Then
                    MailSuchen = objExchListe.PrimarySmtpAddress
                End If
        End Select
    End If
End Function

如果我使用这样的名称，这将按预期返回电子邮件地址：

MailSuchen("Max,Mustermann") => "[e-mail]"

如果我使用部门名称，则不会返回任何内容。 （我公司的部门只有一个对应的邮件地址）

MailSuchen("A 0123") => ""

另一方面，如果我在新电子邮件中手动输入“ A 0123”作为收件人并按Alt-K，它将解析为正确的邮件地址。

据我了解，解决方法应该与按Alt-K时相同。

有人暗示吗？

谢谢你， MZiegaus

解决方法

由于Outlook和Extended MAPI都可以工作，但是OOM不能工作，所以我只能建议使用Redemption-类似的方法：

Function MailSuchen(strSuchen As String)
  set rSession = CreateObject("Redemption.RDOSession")
  rSession.MAPIOBJECT = Outlook.Application.Session.MAPIOBJECT
  Set objEmpfaenger = rSession.AddressBook.ResolveName(strSuchen)
  MailSuchen = objEmpfaenger.SMTPAddress
End Function