Как работать с адресной книгой MS Exchange с помощью Visual Basic

Наш читатель Виктор Крюков поделился своим опытом работы с адресной книгой MS Exchange.
В организации, где он работает, почтой управляет MS Exchange 2000, поэтому результат обращения к свойству ContactItem.Email1Address выглядит примерно так:

Листинг 1.

Как же получить реальный адрес? Виктор предлагает такой рецепт.

— Объект, который хранит информацию о пользователе, — это AddressEntry, находящийся в коллекции AddressEntries, которая, в свою очередь, находится в объекте AddressList коллекции AddressLists данной сессии. У этого объекта есть семейство Fields, которое и хранит нужные свойства. Видимо, для доступа эти свойства проиндексированы какими-нибудь именованными константами типа PR_ADDRESS_EMAIL и т.п., но я их не нашел.

делать цикл по всем полям и искать значение, содержащее ’@’ в качестве подстроки; найти значение, которое является массивом, — оно всего одно, представляет собой массив строк и содержит строчки примерно такого вида (этот вариант кажется более надежным):

Листинг 2.

SMTP:_servrice@ufg.com  

 MS:UFG/UFG/Service  

 CCMAIL: Service at UFG  

 X400:c=RU;a= ;p=UFG;o=UFG;s=?service;

то есть это адреса в разных форматах. Из данного массива выбирается строчка, начинающаяся с ’SMTP’, и обрезается начало, которое и является правильным ответом. Вот код для примера (я добавляю в коллекцию Result все имена и адреса), для выполнения которого требуется в References подключить Microsoft CDO 1.21 Library.

Листинг 3.

Private Sub Form_Load()  

  Dim oSession As MAPI.Session  

  Dim oAList As MAPI.AddressList  

  Dim oAEntry As MAPI.AddressEntry  

  Dim oValue As Variant  

  Dim i As Integer, v As Variant, j As Integer  

  Dim Result As New Collection  

   

  ' Logon to the MAPI session  

  Set oSession = New MAPI.Session  

  oSession.Logon  

   

  ' Get the Global Address List  

  Set oFolder = oSession.AddressLists("Global Address List")  

  For Each oEntry In oFolder.AddressEntries  

    For i = 1 To oEntry.Fields.Count  

      v = oEntry.Fields(i).Value  

      If IsArray(v) Then  

        For j = LBound(v) To UBound(v)  

         If Mid(v(j), 1, 5) = "SMTP:" Then  

           Result.Add Mid(v(j), 6) & " : " & oEntry.Name  

           GoTo continue  

         End If  

        Next j  

      End If  

    Next i  

continue:  

  Next oEntry  

   

  For i = 1 To Result.Count  

    MsgBox Result(i)  

  Next i  

End Sub