用于验证在 Outlook 全局地址列表中找到的电子邮件地址的 VBA 代码答案

【问题标题】：VBA CODE to Verify Email Address Found in Outlook Global Address List用于验证在 Outlook 全局地址列表中找到的电子邮件地址的 VBA 代码
【发布时间】：2020-05-20 19:53:29
【问题描述】：

问题描述

在将电子邮件发送到 Excel 中可用 Outlook 电子邮件帐户列表之前，删除全局地址列表中未找到的非活动（非现有）电子邮件帐户

解决方案

运行 sql 查询以从数据库中获取用户名或用户电子邮件 ID

第一步：

查询 1：

strSQL = "select distinct [User Email ID]  from dbo.vw_EmailRecipients_AT where Report_Catalog_ID in (" & rptid & ")"

或

查询 2：

strSQL = "select distinct [User Name]  from dbo.vw_EmailRecipients_AT where Report_Catalog_ID in (" & rptid & ")"

第 2 步：

调用模块将检索结果集复制到 Excel 工作表

Sub Testemail()
    Dim rEmails As Range
    Dim rEmail As Range
    Dim oOL As Object

    Set oOL = CreateObject("Outlook.Application")
    Set rEmails = ThisWorkbook.Sheets("Report_Users").Range("A2:A" & Range("A65000").End(xlUp).Row)

    For Each rEmail In rEmails
        rEmail.Offset(, 1) = ResolveDisplayNameToSMTP(rEmail.Value, oOL)
    Next rEmail

End Sub

第 3 步：

解析显示名称

Public Function ResolveDisplayNameToSMTP(sFromName, OLApp As Object) As String

    Dim oRecip As Object 'Outlook.Recipient
    Dim oEU As Object 'Outlook.ExchangeUser
    Dim oEDL As Object 'Outlook.ExchangeDistributionList

    Set oRecip = OLApp.Session.CreateRecipient(sFromName)
    oRecip.Resolve
    If oRecip.Resolved Then
        ResolveDisplayNameToSMTP = "Valid"
    Else
        ResolveDisplayNameToSMTP = "Not Valid"
    End If
End Function

错误 1：如果我使用查询 1：结果集将是 abcdef@company.com，其中所有电子邮件 ID 都是有效的 - WRONG_RESULT。

错误 2：如果我使用查询 2：结果集将是 UserName 的组合像 Rajan jha(rjhan) 和合同员工将是 Rajan jha (rjhan - Compnay1 在 Compnay2)

在这个结果中，带有 Rajanjha(rjahan) 的输出，如果在 GAL 中找到电子邮件帐户，它将是有效的，如果没有找到，它将是无效的电子邮件。对于像 Rajan jha (rjhan - Compnay1 is at Compnay2) 这样的结果集，甚至电子邮件帐户存在于 GAL 中，导致无效。

请指导我解决这个问题

【问题讨论】：

在没有完全理解他的问题的情况下，我相信根本问题是在某些情况下 VBA 无法检索 GAL 数据。 VBA 答案可能涉及循环整个 GAL。请参阅此处，建议通过 Redemption RDOSession.AddressBook.GAL.ResolveName 提供替代解决方案。 stackoverflow.com/questions/13825214/…
感谢 niton，当我在链接解决方案中检查时，可用的是需要很长时间才能运行。关于RDOSession。我需要下载软件。我被禁止用于商业目的。是否有任何其他选择来解决问题。我并不是专门在 GAL 中查找电子邮件帐户。如果在本地地址中没有找到它。
如果您已放弃 GAL，则此处描述了一种从联系人中检索的方法How to get Email address from outlook contacts for the names listed in a column?
感谢 Niton，正如我看到评论中提供的链接帮助我识别“本地联系人未更新地址”，所以我只能使用 o.Session.AddressLists("Global Address List")。但是检查全局地址条目名称中每个名称的条件是否需要花费很多时间。但我不能使用 RDOSession 。但是为什么Receipient.Resolve 无法准确解析所有电子邮件帐户。是否有任何其他财产可以强制解决收件人。
感谢 @niton 的支持并帮助保持一致性以解决此问题。但我已经解决了相同公司名称的电子邮件 ID 的问题。 ` Set oRecip = OLApp.Session.CreateRecipient(sFromName) oRecip.Resolve oRecipName = oRecip.Name If oRecip.Resolved And InStr(oRecipName, "@") = 0 Then ResolveDisplayNameToSMTP = "Valid" Else ResolveDisplayNameToSMTP = "Not Valid" End If `

标签： excel vba email

【解决方案1】：

我已经通过对中间输出的条件检查进行小的更改来解决问题。

Public Function ResolveDisplayNameToSMTP(sFromName, OLApp As Object) As String

    Dim oRecip As Object  'Outlook.Recipient

    Set oRecip = OLApp.Session.CreateRecipient(sFromName)
    oRecip.Resolve
    oRecipName = oRecip.Name

    If oRecip.Resolved And InStr(oRecipName, "@") = 0 Then
        ResolveDisplayNameToSMTP = "Valid"
    Else
        ResolveDisplayNameToSMTP = "Not Valid"
    End If

End Function

这里oRecip.Resolve正在解析活动和非活动电子邮件ID的电子邮件ID 同一公司和InStr(oRecipName, "@") = 0 在删除无效电子邮件 ID 方面起着关键作用。

非活动电子邮件oRecip.Resolve 会将输出解析为有效。但输出将是

rajaanjha@company1.com

这里InStr(oRecipName, "@") = 0 检查字符串中的@ 并标记为无效的电子邮件ID

活动电子邮件oRecip.Resolve 会将输出解析为有效。但输出将是

用户电子邮件 ID 的 Rajan Kumar Jha（第一个中间姓氏）其中@ 不在中间字符串中，它是有效的电子邮件 ID。

但我的电子邮件 ID 有问题

rajanjha@company2.com

如果活动电子邮件 ID 的公司未解析为需要解决的用户名。

【讨论】：

太棒了，这就是我需要的:)

【解决方案2】：

我同意尼顿。而不是为此使用 VBA，而且我是 VBA 的忠实粉丝，我会说使用下面 URL 中描述的方法来获取 GAL。

https://www.extendoffice.com/documents/outlook/3590-outlook-export-gal-to-csv.html

我已尝试使用 VBA 下载与 Outlook 中所有联系人相关的所有数据，但后果很严重。如果您使用内置控件并按照上述步骤操作，您将快速准确地获得所需的一切。如果您尝试开发自己的自定义 VBA 解决方案，您将完全靠自己......

【讨论】：