Verify Email address against Outlook

[anasazii]

I'm automating a report that gets sent to users based on criteria the user enters. The name of the user will be used with the docmd.sendobject to email the report. Does anyone know of a way to verify that the name is in the Outlook address book and will be sent ok? Right now, I have created an Outlook object representing the Address Book and search it to find the name the report is being sent to. Just wondering if there were any simpler way to do this?

Thanks, Janel

Some of my code -

Dim rs As DAO.Recordset
Dim sManager As String
Dim dBegDate As Date
Dim dEndDate As Date
Dim sNoSend As String
Dim i As Integer
Dim bExists As Boolean

Dim oApp As Outlook.Application
Dim oNS As Outlook.NameSpace
Dim oAList As Outlook.AddressList
Dim oAListEntry As Outlook.AddressEntries

Const cQry = "qryRegionalManager"
Const cRpt = "rpt_Leads_By_Manager"

If ((Nz(Me.FromDate, &quot;&quot <> &quot;&quot And (Nz(Me.ToDate, &quot;&quot)) Then

If (MsgBox(&quot;Please confirm you wish to automate the report process for dates entered&quot;, vbQuestion + vbYesNo, &quot;Confirm Automation&quot = vbYes) Then

Set oApp = New Outlook.Application
Set oNS = oApp.GetNamespace(&quot;MAPI&quot
Set oAList = oNS.AddressLists(&quot;Global Address List&quot

If (oAList Is Nothing) Then

MsgBox &quot;Unable to automate report. Cannot verify email addresses of Managers.&quot;, vbInformation, &quot;Unable to Automate Report&quot;

Else

DoCmd.Hourglass (True)

Set oAListEntry = oAList.AddressEntries

Set rs = CurrentDb.OpenRecordset(cQry)

If (rs.RecordCount <> 0) Then

rs.MoveFirst

Do While Not (rs.EOF)

sManager = Nz(rs![Regional_Sales_Manager], &quot;&quot
dBegDate = Me.FromDate
dEndDate = Me.ToDate

If (sManager <> &quot;&quot Then

Me.Manager = sManager

'verify that manager exists in address book

bExists = False

'MsgBox &quot;begin time - &quot; & Timer()

For i = 1 To oAListEntry.Count

If (oAListEntry.Item(i).Name = sManager) Then

bExists = True
Exit For

End If

Next i
'MsgBox &quot;end time - &quot; & Timer()

If (bExists) Then

DoCmd.SendObject acSendReport, cRpt, acFormatRTF, sManager, , , &quot;Sales Leads for &quot; & dBegDate & &quot; - &quot; & dEndDate, Editmessage:=False

Else

sNoSend = sNoSend & sManager & vbNewLine

End If

End If 'smanager <> &quot;&quot;

rs.MoveNext

Loop

If (sNoSend <> &quot;&quot Then

MsgBox &quot;Unable to verify email addresses for the following recipients - &quot; & vbNewLine & sNoSend, vbInformation, &quot;Unable to Email all Reports&quot;

End If

End If 'record count verification

End If 'address book verification

End If 'verify automation

Else

MsgBox &quot;Beginning and Ending Dates are both required&quot;, vbInformation, &quot;Missing Required Information&quot;

End If 'date verification