Address Resolution in Workgroup mode

[Dirk Kok]

Hi Everyone

I've posted some Oultook2000 code that allows the user to open the
Addressbook via CDO and select some recipients. I then attempt to
resolve the addresses and extract the mobile numbers. This works fine
when outlook is running in Internet Only mode, however, some of my
users are using Corporate/Workgroup mode. In the latter case only the
name is resolved and I am a bit stuck on how to get this working.

Any help would be greatly appreciated.
Thanks

dim oSession ' Session Object
dim oRecipients ' Recipients Collection
dim oRecipient ' Recipient Object
dim oUserField ' User Field Object

' Create a MAPI session
Set oSession = Application.CreateObject("MAPI.Session")

'logon using a shared session
oSession.Logon "", "", False, False

' set recipients object
on error resume next
Set oRecipients = oSession.AddressBook
if err.number <> 0 then exit sub
if oRecipients.count = 0 then exit sub
on error goto 0

' initialize the strings
xmlRecipients = "<SendTo>"
xmlErrors = ""

' set the userfield object to the field on the form
set oUserField = Item.UserProperties.Find("RecipientsTextBoxField")
oUserField = ""

' for each recipient selected
for each oRecipient in oRecipients

xmlRecipients = xmlRecipients & vbCrLf & "<Recipient>"
xmlRecipients = xmlRecipients & vbCrLf & "<Name>" &
oRecipient.AddressEntry.Fields(805371934).Value & "</Name>"
on error resume next
xmlRecipients = xmlRecipients & vbCrLf & "<Number>" &
oRecipient.AddressEntry.Fields(974913566).Value & "</Number>"
if err.number = -2147221233 then
xmlRecipients = xmlRecipients & vbCrLf & "<Number></Number>"
end if
on error goto 0
xmlRecipients = xmlRecipients & vbCrLf & "</Recipient>"

' set the userfield object to the field on the form
set oUserField = Item.UserProperties.Find("RecipientsTextBoxField")

' add the recipient name to the user field
if oUserField.Value = "" then
oUserField.Value = oRecipient.AddressEntry.Fields(805371934).Value
else
oUserField.Value = oUserField.Value & "; " &
oRecipient.AddressEntry.Fields(805371934).Value
end if

next

xmlRecipients = xmlRecipients & vbCrLf & "</SendTo>"

' log off the session
oSession.Logoff

set oSession = nothing
set oRecipients = nothing
set oRecipient = nothing
set oUserField = nothing