Redemption Objects

[Tim]

I have built a function to extract user information from
an address list from the Global Address list. The problem
at this point is that I get a security prompt when I call
..AddressEntries. I have done some reading about
Redemption, but I can't find an AddressList object in
Redemption.

All help is greatly appreciated.


Sub TestGetMembersId()
Dim Rs As ADODB.Recordset, sTmp As String
GetMembersId sAddressName:="DCPP PROC Writers", Rs:=Rs
If Rs.RecordCount = 0 Then Exit Sub
MsgBox Rs.RecordCount
Rs.MoveFirst
Do While Not Rs.EOF
sTmp = "Id: " & Rs!ID & _
", Last: " & Rs!Last & _
", First: " & Rs!First & _
", Full: " & Rs!Full
Debug.Print sTmp
Rs.MoveNext
Loop
End
End Sub

Sub GetMembersId(sAddressName As String, Rs As ADODB.Recordset)
On Error Resume Next
Dim objSession As New MAPI.Session
Dim objAddress As MAPI.AddressEntry
Dim mAddress As MAPI.AddressEntry
Dim oList As MAPI.AddressList
Set Rs = New ADODB.Recordset
Rs.CursorLocation = adUseClient
Rs.Fields.Append "Id", adVarChar, 9
Rs.Fields.Append "First", adVarChar, 100
Rs.Fields.Append "Last", adVarChar, 100
Rs.Fields.Append "Full", adVarChar, 200
Rs.Open

objSession.Logon "Default Outlook Profile", , , False
If objSession Is Nothing Then Exit Sub

Set oList = objSession.GetAddressList(CdoAddressListGAL)
Set objAddress = oList.AddressEntries.Item(sAddressName)
'Security Prompt
Debug.Print objAddress.Name
For Each mAddress In objAddress.Members
Rs.AddNew Array("Id", "First", "Last", "Full"), _
Array(mAddress.Fields(973078558).Value, _
mAddress.Fields(973471774).Value, _
mAddress.Fields(974192670).Value, _
mAddress.Fields(-2113798114).Value)
Next
objSession.Logoff
Set objSession = Nothing: Set oList = Nothing: Set objAddress = Nothing
End Sub

 

[Dmitry Streblechenko]

Create an instance of the Redemption.AddressLists object (plural) and go
from there: it tis very similar to the Namespace.AddressLists collection in
OOM.

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool