VBA CODE to Verify Email Address Found in Outlook Global Address List
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
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 & ")"
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 firstname.lastname@example.org 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