Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/26.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 验证在Outlook全局地址列表中找到的电子邮件地址的VBA代码_Excel_Vba_Email - Fatal编程技术网

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

Excel 验证在Outlook全局地址列表中找到的电子邮件地址的VBA代码,excel,vba,email,Excel,Vba,Email,问题描述 在将电子邮件发送到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

问题描述

在将电子邮件发送到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有效的位置-错误的\u结果

错误2:如果我使用查询2:结果集将是用户名的组合 与Rajan jha(rjhan)一样,合同雇员也将是Rajan jha(rjhan-Compnay1位于Compnay2)

在这个结果中,与Rajanja(rjahan)的输出,如果在GAL中找到电子邮件帐户,它将有效,如果没有找到,它将是无效的电子邮件。对于像Rajan jha(Rjan-Compnay1位于Compnay2)这样的结果集,即使在GAL中存在电子邮件帐户,它也会导致无效


请指导我如何解决此问题

我通过对中间输出的状态检查进行微小更改,解决了此问题

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

但是我有个问题,我想

rajanjha@company2.com


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

我同意尼顿的观点。我是VBA的超级粉丝,我想用下面URL中描述的方法来抓取GAL,而不是使用VBA


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

在没有完全理解问题的情况下,我认为根本问题是在某些情况下VBA无法检索GAL数据。VBA答案可能涉及循环整个GAL。请参见此处,其中建议使用Redemption
RDOSession.AddressBook.GAL.ResolveName
替代解决方案。感谢尼顿,因为我检查了链接解决方案,可用的是需要很长时间才能运行。关于离婚。我需要下载软件。我被禁止用于商业目的。解决这个问题还有其他选择吗。我不是特别想在GAL中找到电子邮件帐户。如果在本地地址中找不到,那就好了。如果您已经放弃了GAL,那么这里介绍了一种从联系人中检索的方法,谢谢Niton,因为我看到了评论中提供的链接u帮助我识别“本地联系人未更新地址”,因此我必须使用
o.Session.AddressList(“全球地址列表”)
仅限。但检查全局地址条目名称中每个名称的条件需要花费很多时间。但是我不能使用
RDOSession
。但是为什么
receipent.Resolve
并不能准确解析所有电子邮件帐户。是否有任何其他属性强制解析receipent。感谢@niton的支持和帮助为了保持一致性来解决这个问题。但我已经解决了相同公司名称的电子邮件id的问题。`Set-oRecip=OLApp.Session.CreateRecipient(sFromName)oRecip.Resolve oRecipName=oRecip.Name如果oRecip.Resolved And InStr(oRecipName,“@”)=0,则ResolveDisplayNameToSMTP=“Valid”否则ResolveDisplayNameToSMTP=“Not Valid”如果“太棒了,这就是我需要的:)