VBA CODE to Verify Email Address Found in Outlook Global Address List

Question

Problem Description

To remove Inactive (non existing )email accounts not found in global address list before send email to list of available outlook email accounts in excel

Solution

Run sql Query to fetch Username or User Email id from Database

Step 1 :

Query 1 :

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

or

Query 2 :

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

Step 2 :

Call the Module to Copy retrieve Result Set to Excel Sheet

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

Step 3 :

Resolve Display Name

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

Bug 1: If I Use Query 1 : The resultset will be [email protected] where all the email id will be valid - WRONG_RESULT.

Bug 2: If I Use Query 2 : The resultset will be combination of UserName like Rajan jha(rjhan) and contract employees will be Rajan jha (rjhan - Compnay1 is at Compnay2)

In this result the output with Rajanjha(rjahan), if the email account is found in GAL it will valid and if not found it will be Invalid email.For resultset like Rajan jha (rjhan - Compnay1 is at Compnay2) where even email account exist in GAL it result as invalid.

please guide me through to solve this problem

Without fully understanding he question, I believe the root problem is in some cases VBA does not feasibly retrieve GAL data. A VBA answer may involve looping the entire GAL. See here where an alternative solution through Redemption RDOSession.AddressBook.GAL.ResolveName is suggested. stackoverflow.com/questions/13825214/… — niton
Thanks niton, As I checked in the link solution what is available is takes a long time to run. Regarding RDOSession. I need download Software. I have been not allowed use for commercial Purpose. Is there any other Choices to solve the problem. I am not specific to find email Accounts in GAL. If it is not found in local Address fine. — Mallikarjuna Shivappa
If you have given up on the GAL then one method of retrieving from Contacts is described here How to get Email address from outlook contacts for the names listed in a column? — niton
Thanks Niton , As I saw link u provided in the comment help me Identify "local Contact not Updated with Address" , so I have to use o.Session.AddressLists("Global Address List") only. But It takes to took much time to check if Condition for each Name in the Global Address Entry Name. But I cannot use RDOSession . But Why Receipient.Resolve is not accurately resolve for all email Accounts. Is there any other property forceful to resolve the receipient. — Mallikarjuna Shivappa
Thanks @niton for Support and helping to keep Consistency to work this problem. But I have solved problem for Email id of the Same Company Name. ` 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 ` — Mallikarjuna Shivappa

Mallikarjuna Shivappa Mallikarjuna Shivappa · Accepted Answer · 2017-11-20T06:54:08

I have solved Problem by making small changes in Condition Checking of Intermediate Output.

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

Here oRecip.Resolve is resolving Email Id of Active and Inactive Email ID Of Same Company and InStr(oRecipName, "@") = 0 plays key role to remove invalid email id.

Inactive Email oRecip.Resolve will Resolve output to valid. But the output will be

[email protected]

Here InStr(oRecipName, "@") = 0 checks for @ in the String and flag as Invalid Email Id

Active Email oRecip.Resolve will Resolve output to valid. But the output will be

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

But I have problem Email ID like

[email protected]

Where Active Email ID's Company is not getting Resolved to User name which need to be Solved.

VBA CODE to Verify Email Address Found in Outlook Global Address List

2 Answers