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

Question

问题描述

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

解决方案

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

第1步 ：

查询 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：结果集将是用户名的组合，如 Rajan jha(rjhan)，合同员工将是 Rajan jha（rjhan - Compnay1 在 Compnay2）

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

请指导我解决这个问题

Answer 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 的公司没有被解析为需要解决的用户名。

Answer 2

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

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

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