Поиск в глобальном списке адресов из Outlook

Я создаю инструмент, который требуется для поиска в глобальном списке адресов в Outlook, чтобы найти определенного сотрудника и вернуть его адрес электронной почты, адрес электронной почты его руководителя и менеджера и, наконец, адрес электронной почты руководителя и менеджера.

Я нашел код и настроил его для поиска имени человека; однако, если у вас есть два Боба Смита, я требую, чтобы это было более конкретным при поиске, либо по адресу электронной почты, либо по псевдониму.

Любой найденный мной код создает массив со всеми пользователями на сервере обмена; однако с миллионами записей о сотрудниках это занимает много времени, и это будет выполняться один раз в неделю для обновления информации.

Есть ли способ поиска в идеале по псевдониму или, во-вторых, по адресу электронной почты SMTP?

Я нашел версии кода и изменил их в соответствии со своими требованиями, но все еще не могу найти по псевдониму или адресу электронной почты. Если я сделаю это вручную, я могу щелкнуть расширенный поиск и ввести псевдоним или щелкнуть «дополнительные столбцы» и выполнить поиск по псевдониму, и появится правильный результат.

Могу ли я определить «Больше столбцов» в коде VBA?

    Dim myolApp As Outlook.Application
    Dim myNameSpace As Namespace
    Dim myAddrList As AddressList
    Dim myAddrEntry As AddressEntry
    Dim AliasName As String
    Dim i As Integer, r As Integer
    Dim c As Range
    Dim EndRow As Integer, n As Integer
    Dim exchUser As Outlook.ExchangeUser

    Set myolApp = CreateObject("Outlook.Application")
    Set myNameSpace = myolApp.GetNamespace("MAPI")
    Set myAddrList = myNameSpace.AddressLists("Global Address List")
    Dim FullName As String, LastName As String, FirstName As String
    Dim LDAP As String, PhoneNum As String
    Dim StartRow As Integer

    EndRow = Cells(Rows.Count, 1).End(xlUp).Row

    StartRow = 2

    For Each c In Range("I" & StartRow & ":I" & CStr(EndRow))
        AliasName = LCase(Trim(c))
        c = AliasName
        Set myAddrEntry = myAddrList.AddressEntries(AliasName)
        Set exchUser = myAddrEntry.GetExchangeUser

        If Not exchUser Is Nothing Then
            c.Offset(0, 1) = exchUser.FirstName
            c.Offset(0, 2) = exchUser.LastName
            c.Offset(0, 3) = exchUser.Alias
            c.Offset(0, 4) = exchUser.PrimarySmtpAddress
            c.Offset(0, 5) = exchUser.Manager
           'etc...
        End If
    Next c
# excel
Источник
Codelisting
за 1 против

Вы проверилиCreateRecipient пространство имен? https://docs.microsoft.com/en-us/office/vba/api/outlook.namespace.createrecipient

Вы можете попробовать создатьrecipient объект, передающий псевдонимCreateRecipient метод:

Set myNamespace = Application.GetNamespace("MAPI")
Set recip = myNamespace.CreateRecipient("YourAlias")
recip.Resolve

Вы, конечно, должны проверить, правильно ли решен ваш получатель, проверивresolved имущество:

If recip.Resolved Then 'Do something

Получив получателя, вы можете создать из него пользователя Exchange с помощьюGetExchangeUser метод изAdressEntry свойство в объекте получателя.

Set exchUser = recip.AddressEntry.GetExchangeUser
Debug.Print exchUser.PrimarySmtpAddress

И я уверен, что вы сможете решить это оттуда!

  • 0
    Спасибо, я пошел по этому пути, и теперь у меня есть 5 функций для возврата значений, однако мне было интересно, есть ли простой способ вернуть несколько значений, возможно, в виде объектов? Я могу возвращать отдельные строки и создавать необходимое содержимое, но, поскольку он неоднократно проверяет сервер Exchange, его уровень низкий. Также есть одна дополнительная ошибка с этим методом, если вы знаете, как ее обойти: у меня есть псевдонимы как 12345 и 123456. Каждый раз, когда я пробую 12345, он не разрешается? Есть ли способ заставить это выбрать правильного пользователя? Добавлю пост с новым кодом ...
  • 0
    Вы идете неверным путем. Вы запускаете GetName каждый раз, когда вам нужно свойство объекта, которое вызывает CreateRecipient и Resolve для каждого элемента, который вы хотите получить. Вместо этого попробуйте создать функцию, которая возвращает объект-получатель, а затем извлекает желаемые свойства из этого объекта. Поступая таким образом, вам не нужно будет каждый раз вызывать resolve, что, я уверен, излишне забивает сервер Exchange.
за 0 против

Мне удалось найти решение со следующей функцией.

Function GetName(strAcc As String) As Variant

Dim lappOutlook As Outlook.Application
Dim lappNamespace As Outlook.Namespace
Dim lappRecipient As Outlook.Recipient

'Dim strAcc As String

Dim maxTries As Long
Dim errCount As Long

Set lappOutlook = CreateObject("Outlook.Application")
Set lappNamespace = lappOutlook.GetNamespace("MAPI")


Set lappRecipient = lappNamespace.CreateRecipient(strAcc)

maxTries = 2000

On Error GoTo errorResume

Retry:

    DoEvents

    ' For testing error logic. No error with my Excel 2013 Outlook 2013 setup.
    ' Should normally be commented out
    'Err.Raise 287

    lappRecipient.Resolve

On Error GoTo 0


Set olAddrEntry = lappRecipient.AddressEntry



If lappRecipient.Resolved Then
    Set olexchuser = olAddrEntry.GetExchangeUser

    GetName = olexchuser.Name
Else
    GetName = "Unable To Validate LDAP"
End If

ExitRoutine:

    Set lappOutlook = Nothing
    Set lappNamespace = Nothing
    Set lappRecipient = Nothing

    Exit Function

errorResume:

    errCount = errCount + 1

    ' Try until Outlook responds
    If errCount > maxTries Then

        ' Check if Outlook is there and Resolve is the issue
        lappNamespace.GetDefaultFolder(olFolderInbox).Display
        GoTo ExitRoutine

    End If

    'Debug.Print errCount & " - " & Err.Number & ": " & Err.Description
    Resume Retry

End Function

Есть ли способ вернуть следующие значения Exchange для консолидации функции, чтобы она просматривалась на сервере обмена только один раз?

Получить .Name .PrimarySmtpAddress .Manager .Manager.PrimarySmtpAddress .Manager.Alias

Затем я просматриваю и получаю менеджеров, менеджера и электронную почту.

Я использую следующую SUB, чтобы иметь возможность извлекать необходимую информацию (в окно сообщения при построении, но данные будут заполнять таблицу после завершения).

Sub GetDetails()
Dim Name As String, Email As String, Manager As String, ManagersEmail As String, MD As String, MDEmail As String, Lookup As String

Lookup = GetManagerAlias("3511931")    '("3359820")

Name = GetName(Lookup)
Email = GetEmail(Lookup)
Manager = GetManager(Lookup)
ManagersEmail = GetManagersEmail(Lookup)
MD = GetManager(GetManagerAlias(Lookup))
MDEmail = GetManagersEmail(GetManagerAlias(Lookup))

MsgBox Name & vbNewLine & Email & vbNewLine & Manager & vbNewLine & ManagersEmail & vbNewLine & MD & vbNewLine & MDEmail

End Sub
Codelisting
Популярные категории
На заметку программисту