Help getting current user email address using Outlook Redemption???

  • Thread starter Thread starter Kristy
  • Start date Start date
K

Kristy

I am using an Exchange Server, Office XP, and have written a Com
add-in (VB6) and I need to get the default email address of the
current user.

I have been using this, which works OK but the
'objSession.CurrentUser' invokes security prompts ...

Set golApp = CreateObject("Outlook.Application")
Set objSession = golApp.CreateObject("MAPI.Session")
objSession.Logon "", "", False, False
Set objAddressEntry = objSession.CurrentUser
Set objFields = objAddressEntry.Fields
Set objMailAddresses = objFields.item(PR_EMS_AB_PROXY_ADDRESSES)

If Not objMailAddresses Is Nothing Then
strAddresses = objMailAddresses.Value

For IntCounter = LBound(strAddresses) To UBound(strAddresses)
strSMTP = strAddresses(IntCounter)

etc....

I would like to bypass the security prompts and have purchased Outlook
Redemption to help me with this, however I can't get it to work...

Set golApp = CreateObject("Outlook.Application")
Set objNameSpace = golApp.GetNamespace("MAPI")
Set objAddressEntry = CreateObject("Redemption.SafeCurrentUser")
Set objFields = objAddressEntry.Fields 'error occurring here
Set objMailAddresses = objFields.item(PR_EMS_AB_PROXY_ADDRESSES)

If Not objMailAddresses Is Nothing Then
strAddresses = objMailAddresses.Value

For IntCounter = LBound(strAddresses) To UBound(strAddresses)
strSMTP = strAddresses(IntCounter)

....

I am getting an error "wrong number of arguments or invalid property
assignment" on the following line

Set objFields = objAddressEntry.Fields

Am I going about this completely the wrong way? I have tried all sorts
of different methods from posts I have found but am not getting
anywhere, I am a newbie and my brain is about to explode, does anyone
have a code example of how to achieve this?

Please help me!
 
Unlike CDO, where Fields property on various objects returns a collection
(object), Fields in Redemption is an array property:

replace
Set objFields = objAddressEntry.Fields 'error occurring here
Set objMailAddresses = objFields.item(PR_EMS_AB_PROXY_ADDRESSES)
If Not objMailAddresses Is Nothing Then
strAddresses = objMailAddresses.Value

with
strAddresses = objAddressEntry.Fields(PR_EMS_AB_PROXY_ADDRESSES)
and check the return value type. If the propetty is missing, you will get
back Empty, otherwise a variant array of strings.

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
 
Worked first time, no security prompts whatsoever! Thank you so much,
I have a lot of work to do with redemption over the next month (far
less than if I had to learn a whole other programming language though
- what an awesome product Redemption is) and from the first 2 lines of
your reply I already understand so much more.

Kristy
 
Hi All,

My user is getting an email id in below format. Can you please help me out on which property it give such address?

'/o=companyname/ou=first administrative group/cn=recipients/cn=486bd8b1-715acc23-49257142-28f3f7

Please find below the code flow

Private Function GetRecipEmailAddress(ByRef oAddrEntry As Object) As String
Dim eMail As String

' Try the SMTP address 1st.
eMail = oAddrEntry.Fields(PR_SMTP_ADDRESS)


' Look at all the email properties.
If Len(eMail) = 0 Then
Dim emailAddresses As Variant

' Get an array of addresses for this recipient.
emailAddresses = oAddrEntry.Fields(PR_EMS_AB_PROXY_ADDRESSES)
If (Not IsEmpty(emailAddresses)) Then
Dim r As Long
Dim foundSmtp As Boolean

foundSmtp = False

' Iterate through all the address. We assume the address
' with the capital SMTP: prefix is the main address, but
' if one is not found, then we use the first address with
' a lower case smtp:
For r = LBound(emailAddresses) To UBound(emailAddresses)

' See if this the main address.
If (Left(emailAddresses(r), 5) = "SMTP:") Then

' Found it so we are done.
eMail = Trim(Mid(emailAddresses(r), 6))
Exit For
ElseIf Not foundSmtp Then

' We have not found the address, so if this is an
' smtp address, then use it and set the flag.
If (Left(emailAddresses(r), 5) = "smtp:") Then
eMail = Trim(Mid(emailAddresses(r), 6))
foundSmtp = True
End If
End If
Next r
End If
End If

' Try the email prop next.
If Len(eMail) = 0 Then
eMail = oAddrEntry.Fields(PR_EMAIL)
End If

' Try the email address prop last.
If Len(eMail) = 0 Then
eMail = oAddrEntry.Fields(PR_EMAILADDRESS)
End If

GetRecipEmailAddress = eMail
End Function

Thanks in Advance
Ashok
 
Back
Top