Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

MS Access / Validate email address against Exchange GAL 1

Status
Not open for further replies.

sparkbyte

Technical User
Sep 20, 2002
879
US

This thread was originaly in the Access VBA
thread705-1592612


Anyone know a way to validate email addresses against the Exchange server GAL??

Without importing into access.


I have a need where only requests from "valid" emails can be processed. In this case a 'valid' email is one that is listed in the Exchange Server GAL.

And yes this is VERY big. Requests for information come in from every state.

So what I want to be able to do is this.

Once a request has been input, the Contacts email address is then looked up in the Exchange GAL to make sure the person requesting the information is a current employee. If not, through an error message to the user stating the the email address is either invalid or not present in the GAL.

Here is as close as I can seem to get.

But it retrieves only the first instance of a name.

Code:
Function GetOutlookAddress(strContactName As String)
    Dim outApp As Object, outNS As Outlook.NameSpace
    Dim myAddressList As Outlook.AddressList
    
    Set outApp = CreateObject("Outlook.Application")
    Set outNS = outApp.GetNamespace("MAPI")
    Set myAddressList = outNS.Session.AddressLists("Global Address List")
    Set strUser = myAddressList.AddressEntries(strContactName)
     
'    Debug.Print myAddressList.AddressEntries("fuh")
'    Debug.Print "Name:.......... " & myAddressList.Name
'    Debug.Print "Application:... " & myAddressList.Application
'    Debug.Print "Class:......... " & myAddressList.Class
'    Debug.Print "ID:............ " & myAddressList.ID
'    Debug.Print "Index:......... " & myAddressList.Index
'    Debug.Print "Session:....... " & myAddressList.Session

'    Debug.Print "Session:....... " & myAddressList.Parent

'    Debug.Print "Name Search:... " & myAddressList.AddressEntries("fuhrman")

'    Debug.Print "Name Search:... " & myAddressList.AddressEntries(strContactName)
    
        Debug.Print strUser

    
    Set outApp = Nothing
     
End Function

If the myAddressList.AddressEntries(strContactName) is returning an array I cannot get it to display each entry using a for each loop.

Can someone help with this.. PLEEEEEAAAASSSSEEEE!!!!!!!!


Code:
Sub GetUserName()

Dim strName As String
    strName = InputBox(Prompt:="Your name please.", _
          title:="ENTER YOUR NAME", Default:="Your Name here")

Call GetOutlookAddress(strName)

'        If strName = "Your Name here" Or _
'           strName = vbNullString Then
'           Exit Sub
'        Else
'
''          Select Case strName
''            Case "Bob"
''                'Do Bobs stuff
''            Case "Bill"
''                'Do Bills stuff
''            Case "Mary"
''                'Do Marys stuff
''            Case Else
''                'Do other stuff
''          End Select
'
'
'
'        End If

End Sub

On the new contact form users put in the contacts email address and then are required to manually verify it against the Exchange GAL before they can process the incoming request. If the contact is not in the Exchange GAL the Rep's are not allowed to process the request. I would like to automate the GAL lookup and verify name and contact information against it.




Thanks

John Fuhrman
faq329-6766
faq329-7301
thread329-1334328
thread329-1424438
thread705-1592825
 


hi,
Code:
    Dim outApp As Object, outNS As Outlook.Namespace
    Dim myAddressList As Outlook.AddressList, oUser
    
    Set outApp = CreateObject("Outlook.Application")
    Set outNS = outApp.GetNamespace("MAPI")
    Set myAddressList = outNS.Session.AddressLists("Global Address List")
    
    For Each oUser In myAddressList.AddressEntries
        If Left(oUser, 7) = "fuh" Then
            MsgBox oUser
        End If
    Next

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 



BTW, you can also use an index to return an item.

If it were me, I'd build an index table on the first few characters and then use that table to determine what range of indexices to loop thru, based on the strContactName argument.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
I get a compile error.

ByRef argument type mismatch

MsgBox oUser


Thanks

John Fuhrman
faq329-6766
faq329-7301
thread329-1334328
thread329-1424438
thread705-1592825
 



try MsgBox oUser.Name

FYI, It worked for me, and I did not know why it did not for you, but I 'discovered' the answer using faq707-4594

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Well I was able to get an example working.

But with 311764 entries in the GAL a simple If/Then takes too long.

Any better options to do a name lookup??

Also, I am not sure how to get the contacts SMTP address.
standard email (john.smith@nospam.org).

Code:
Option Compare Database

Option Explicit
Sub olAdresEntries(strGALlookup)

Dim olApp As Object
Dim olNS As NameSpace
Dim olAL As AddressList
Dim olAE As AddressEntry
Dim olFd As MAPIFolder
Dim olCI As ContactItem

    Set olApp = CreateObject("Outlook.Application")
    Set olNS = olApp.GetNamespace("MAPI")
    Set olAL = olNS.AddressLists(1)
    
    Debug.Print "AdressList(1).Name=", olAL.Name
    Debug.Print olAL.AddressEntries.count & " entries in the GAL."

    For Each olAE In olAL.AddressEntries

        With olAE
            On Error Resume Next
            Debug.Print "Name=", .Name
            Debug.Print "Address=", .Address
            Debug.Print "Type=", .Type
       End With
        On Error GoTo 0
    Next


End Sub

Code:
Sub GetUserName()

Dim strName As String
    strName = InputBox(Prompt:="Your name please.", _
          title:="ENTER YOUR NAME", Default:="Your Name here")

    Call olAdresEntries(strName)


End Sub



Thanks

John Fuhrman
 



Use an index pointer to test, in a loop, what you get with where you want to be.
Code:
select case myAddressList.AddressEntries(i)
   case  strContactName
      'this is it!
   case is < strContactName
      'must increase i by some amount
   case else
      'must decrease i by some amount
end select
You would have to work out the algorythm

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 

Code:
Function GetOutlookAddress(strContactName As String)
    Dim outApp As Object, outNS As Outlook.Namespace
    Dim myAddressList As Outlook.AddressList
    Dim i As Long, interval As Long
    
    Set outApp = CreateObject("Outlook.Application")
    Set outNS = outApp.GetNamespace("MAPI")
    Set myAddressList = outNS.Session.AddressLists("Global Address List")
    
     interval = myAddressList.AddressEntries.Count / 2
     i = interval
    Do
        Select Case myAddressList.AddressEntries(i)
            Case Is = strContactName
                GetOutlookAddress = myAddressList.AddressEntries(i)
                Exit Do
            Case Is < strContactName
                i = i + interval / 2
                interval = interval / 2
            Case Else
                i = i - interval / 2
                interval = interval / 2
        End Select
    Loop

    Set outApp = Nothing
    Set outNS = Nothing
    Set myAddressList = Nothing
    
End Function

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
I think I have gotten a little off track here.

I was needing a way to lookup/validate an email address against the Exchange GAL.

The examples all do a name lookup. But, even with the name lookup, it is taking quite a long time to perform the lookup against the GAL.

Thanks

John Fuhrman
 



Did you bother to read the FAQ posted above? FAQ707-4594

Check out the Address property.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Sorry, missed it. I will and let you know.

Thanks!!

Thanks

John Fuhrman
 
OK, I have added watches on each of the major objects and if I am missing something it does not look like the GAL has the SMTP address exposed.

Could this be correct?

Added watches to
myAddressList
outApp
OutNS


Thanks

Code:
Option Compare Database

Function GetOutlookAddress(strContactName As String)
    Dim outApp As Object, outNS As Outlook.NameSpace
    Dim myAddressList As Outlook.AddressList
    Dim i As Long, interval As Long
    Dim x As Integer
    
    Set outApp = CreateObject("Outlook.Application")
    Set outNS = outApp.GetNamespace("MAPI")
    Set myAddressList = outNS.Session.AddressLists("Global Address List")
     
     
     interval = myAddressList.AddressEntries.count / 2
     i = interval
    Debug.Print "Starting interval: " & interval
    Do
        Select Case myAddressList.AddressEntries(i)
            Case Is = strContactName
                Debug.Print strContactName
                Exit Do
            Case Is < strContactName
                Debug.Print ("Case Is < strContactName")
                i = i + interval / 2
                interval = interval / 2
                Debug.Print interval
                If interval <= 0 Then Exit Function
            Case Else
                Debug.Print "Case Else"
                i = i - interval / 2
                interval = interval / 2
                Debug.Print interval
                If interval <= 0 Then Exit Function
       End Select
    Loop

    Set outApp = Nothing
    Set outNS = Nothing
    Set myAddressList = Nothing
    
End Function

Output said:
Starting interval: : & interval
Case Else
77954
Case Is < strContactName
38977
Case Else
19488
Case Is < strContactName
9744
Case Else
4872
Case Is < strContactName
2436
Case Else
1218
Case Else
609
Case Else
304
Case Is < strContactName
152
Case Else
76
Case Is < strContactName
38
Case Else
19
Case Else
10
Case Else
5
Case Else
2
Case Is < strContactName
1
Case Is < strContactName
0




Thanks

John Fuhrman
 
Isn't the AddressEntry.Address what you're after ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
If it has the contacts SMTP email address yes it is.

But I cannot figure out how to get it.

Thanks

John Fuhrman
 
Debug.Print strContactName[!], myAddressList.AddressEntries(i).Address[/!]

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Debug.Print strContactName, myAddressList.AddressEntries(i).Address

That is close but does not have the SMTP email address.
(e.g. john.smith@nospam.org)

I would have to do quite a bit of text manipulation to get the SMTP address from myAddressList.AddressEntries(i).Address



Thanks

John Fuhrman
 



BTW, I've done no significant Outlook VBA coding. All I know is VB, principles of objects and properties, very little about the Outlook Object Model. Just hunted and peck my way to the results I posted.

I'd love to know how to get smtp address. Couldn't find that path.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top