Извлечение контактной информации из адресной книги Outlook с помощью расширенного поиска - PullRequest
Новая
       7

Извлечение контактной информации из адресной книги Outlook с помощью расширенного поиска

0 голосов
/ 26 сентября 2018

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

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

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

Sub GetOutlookInfo()

Dim I As Integer
Dim ToAddr As String
Dim ActivePersonVerified As Boolean
Dim ol As Outlook.Application
Dim DummyEMail As MailItem
Dim ActivePersonRecipient As Recipient
Dim oAE As Outlook.AddressEntry
Dim oExUser As Outlook.ExchangeUser
Dim oPA As Outlook.PropertyAccessor
Dim AliasRange As Range
Dim RowsInRange As Integer

'Instantiate Outlook
Set ol = CreateObject("Outlook.Application")

'E-mail aliases are in a named range "aliasrange"
'Assign the named range to a range object
Set AliasRange = Range("A1:A1000")

'Create a dummy e-mail to add aliases to
Set DummyEMail = ol.CreateItem(olMailItem)
RowsInRange = AliasRange.Rows.Count

'Loop through the aliases to retrieve the Exchange data
For I = 3 To RowsInRange

    'Assign the current alias to a variable ToAddr
    ToAddr = AliasRange.Cells(I, 1)

    'Exit loop
    If ToAddr = "" Then
        Exit For
    End If

    'Use the alias to create a recipient object and add it to the dummy e-mail
    Set ActivePersonRecipient = DummyEMail.Recipients.Add(ToAddr)
    ActivePersonRecipient.Type = olTo

   'Resolve the recipient to ensure it is valid
    ActivePersonVerified = ActivePersonRecipient.Resolve

    'If valid, use the  AddressEntry property of the recipient to return an AddressEntry object

    If ActivePersonVerified Then
        Set oAE = ActivePersonRecipient.AddressEntry

        'Use the GetExchangeUser method of the AddressEntry object to retrieve the ExchangeUser object for the recipient.
        Set oExUser = oAE.GetExchangeUser

        'Write the properties of the  ExchangeUser object to adjacent columns on the worksheet.
        AliasRange.Cells(I, 1).Offset(0, 1).Value = oExUser.Name 
        AliasRange.Cells(I, 1).Offset(0, 2).Value = oExUser.Manager
        AliasRange.Cells(I, 1).Offset(0, 3).Value = oExUser.Department
        AliasRange.Cells(I, 1).Offset(0, 4).Value = oExUser.JobTitle
        AliasRange.Cells(I, 1).Offset(0, 5).Value = oExUser.OfficeLocation
        AliasRange.Cells(I, 1).Offset(0, 6).Value = oExUser.City
        AliasRange.Cells(I, 1).Offset(0, 7).Value = oExUser.StateOrProvince
        AliasRange.Cells(I, 1).Offset(0, 8).Value = oExUser.StreetAddress
        AliasRange.Cells(I, 1).Offset(0, 9).Value = oExUser.Alias
    End If

    'Remove the recipient from the e-mail
    ActivePersonRecipient.Delete

Next I

ExitOutlookEmail:

    Set DummyEMail = Nothing
    Set ol = Nothing

End Sub

1 Ответ

0 голосов
/ 26 декабря 2018

Outlook не позволит вам получить доступ к неоднозначным именам.Имя либо однозначно разрешается, либо оно не выполняется по какой-либо другой причине (не найдено или неоднозначно).

...