Redemption objects for Global Address List

[Tim Johnson]

Hi there,

I have written a function that performs a search through Outlook's GAL using
a person's name as the search field and returning their email address. It
works fine, except for the pesky Outlook security prompt. I have a copy of
Redemption with which I can bypass this, but am unsure which objects to use
and how to set them. I have posted the code below, any assistance in
correctly setting the appropriate Redemption objects is greatly appreciated.

Thanks in advance.

Code:

Function GAL(strName As String) As String
Dim strEnt As String, intCnt As Integer

Set olApp = CreateObject("Outlook.Application")
Set olLst = olApp.Session.AddressLists("Global Address List")
Set olEnts = olLst.AddressEntries

For Each olEnt In olEnts

If olEnt.Name Like "*" & strName & "*" Then
intCnt = intCnt + 1
strEnt = Right(olEnt.Address, Len(olEnt.Address) - InStr(1,
olEnt.Address, "Recipients/cn=") + 1)
strEnt = Replace(strEnt, "Recipients/cn=", "") & "@domain.com"
Debug.Print strEnt
End If
Next olEnt

If intCnt = 1 Then
GAL = strEnt
Else
MsgBox "There are multiple entries in the Global Address List that " _
& "contain that name. Please verify that the email is correct." _
, , "Multiple Names Found"
GAL = strEnt
End If

End Function

 

[Arvin Meyer [MVP]]

The Redemption dll loads with Outlook and does its thing silently.
Redemption objects are for advanced Outlook programming, and not really
necessary for anything done from Access.

 

[Tim Johnson]

Thanks Arvin.

I'm actually already using the Redemption library in my development of a
database in order to send out notifications without the constant annoyance of
the security warnings. It works very nicely between Access and Outlook (as
I'm sure it does between many other languages and Outlook).

Is this question better placed in the Outlook newsgroup?

It was through the Access newsgroup that I first learned of Redemption, so
by habit I came back here.

I have convinced my boss to spend the $200 on Redemption so that
notifications can be sent without required user action (requiring us to
bypass Outlook security) and now he wants to use it as much as possible. In
order to further justify the purchase I am trying to set up a function that
allows other constituents to be added easily to the recordset of people to
receive notifications by setting it up to lookup add in all necessary
information by simply typing in someone's name.

 

[Arvin Meyer [MVP]]

No special coding in Redemption objects are required for that. Redemption
works by suppressing warnings on any computer it's installed on. That means
any code that you write on the Access side that sends an email should work
without Outlook security prompts. The $200 is an enterprise license that
allows you to install Redemption on any computer that your company owns (or
leases).
--
Arvin Meyer, MCP, MVP
http://www.datastrat.com
http://www.mvps.org/access
http://www.accessmvp.com

 

[Tim Johnson]

Thanks again Arvin.

I guess I just wasn't communicating well, I had already written the sub to
send emails, but was trying to expand functionality by autofilling email
addresses in a user list using the GAL. I have discovered the objects I was
looking for. For reference of anyone else trying to do something similar,
the code is below:

Function GAL(strName As String, blnName As Boolean) As String
'//Revised function to retrieve email addresses from Exchnage Global Address
List, using Redemption RDO objects _
to bypass Outlook's native security

Dim olEnts, olEnt As Object, intCount As Integer, strEnt As String, strEmail
As String, strAddyEmail As String


Set oSess = CreateObject("Redemption.RDOSession") 'Create instance of
Redemption
Set olApp = CreateObject("Outlook.Application") 'Create instance of
Outlook
oSess.MAPIOBJECT = olApp.Application.Session.MAPIOBJECT 'Set the
Redemption MAPI to Outlook's MAPI to bypass _
'security

Set oGAL = oSess.AddressBook.AddressLists(True).Item("Global Address List")
'Access the Global Address List
Set olEnts = oGAL.AddressEntries
'Access the Addresses Collection

If blnName = False Then 'is an email address
If InStr(1, strName, "@") > 0 Then
strEmail = Left(strName, InStr(1, strName, "@") - 1) 'Only grab
the email prior to domain
Else
strEmail = strName
End If
MsgBox "Email: " & strEmail
End If

For Each olEnt In olEnts 'Iterate through each individual listing searching
for contact

If blnName = True Then 'Search by name for email
If olEnt.Name Like "*" & strName & "*" Then
'//Keep tally of how many names match this search
intCnt = intCnt + 1
'//Using the GAL address, remove all coding and insert the domain
strEnt = Right(olEnt.Address, Len(olEnt.Address) - InStr(1,
olEnt.Address, "Recipients/cn=") + 1)
strEnt = Replace(strEnt, "Recipients/cn=", "") & "@domain.com"
'replace domain with your company's domain
End If
Else

'//Grab the GAL address, removing all coding
strAddyEmail = Right(olEnt.Address, Len(olEnt.Address) - InStr(1,
olEnt.Address, "Recipients/cn=") + 1)
strAddyEmail = Replace(strAddyEmail, "Recipients/cn=", "")


If strAddyEmail = strEmail Then strEnt = olEnt.Name 'match found

End If
Next olEnt

If intCnt > 1 Then 'If there are more than 1 possible contacts, warn
the user
MsgBox "There are multiple entries in the Global Address List that " _
& "contain that name. Please verify that the email is correct." _
, , "Multiple Names Found"

End If

GAL = strEnt
End Function

 

[Arvin Meyer [MVP]]

I understand. I've never used the Outlook (or Exchange) email list to send
out emails like this. The Outlook contact list is not very good at avoiding
duplicates or even maintaining a specific list that multiple users cannot
delete or incorrectly edit. I've always kept the global contact list in
Access where I can control duplicates, edits, and deletes, and validate
entries.

I see in your code that you are trying to handle some of the validation
problems.

As far as I know, Exchange works only from the client, so all you should
need to do is distribute Redemption to each computer that will use your
code.
--
Arvin Meyer, MCP, MVP
http://www.datastrat.com
http://www.mvps.org/access
http://www.accessmvp.com