excel - 验证在 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:结果集将是 UserName 的组合
像 Rajan jha(rjhan) 和契约(Contract)员工将是 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将输出解析为有效。但输出将是

Rajan Kumar Jha (First Middle Last Name) of User Email Id Where @ will not be in Intermediate String and it is Valid Email Id.

但我有问题电子邮件 ID，例如

rajanjha@company2.com

事件电子邮件 ID 的公司未解析为需要解决的用户名。