Accessing Address Book with Redemption Object Model

[AB]

I am trying to access the address book and store the relevant details
on a custom form by looping through each selected recipient, which will
then be used with an event sink to send out emails to the chosen
recipients. I want to be able to do this without getting any Outlook
security warnings. I have been able to use the Redemption Object Model
in regards to storing the current users details, but cannot work out
how to go about changing the code below. Code below is from the custom
form.

Any help would be greatly appreciated.

Thanks in advance,
AB

'Open Address Book
'-----------------
Set objCDOSession = Application.CreateObject("MAPI.Session")
objCDOSession.Logon "", "", False, False, 0

set objRecipients = objCDOSession.AddressBook (Nothing, "Outlook",
False, True, 1, "Add", "", "", 0)

'Fill Custom fields with names and email addresses
'-----------------------------------
For each objRecipient in objRecipients

'Get SMTP address
strEMailAddress =
objRecipient.AddressEntry.Fields(CdoPR_EMAIL).Value

'Store Names and SMTP addresses in hidden fields, as well as "To"
field
if Trim(Item.UserProperties("To").value) = "" then
Item.UserProperties("To").value = objRecipient.Name
Item.UserProperties("Approver" & lngApproverNo).value =
objRecipient.Name
Item.UserProperties("Approver" & lngApproverNo & "Email").value =
strEMailAddress

'rest of code not required