简体   繁体   中英

How to pull from Outlook Address book based on values in Excel (VBA)

I have the following code that works (I found it on a forum):

Public Sub GetUsers()
Dim myolApp As Outlook.Application
Dim myNameSpace As Namespace
Dim myAddrList As AddressList
Dim myAddrEntries As addressEntry
Dim AliasName As String
Dim i As Integer, r As Integer
Dim EndRow As Integer, n As Integer
Dim myStr As String, c As Range
Dim myPhone As String
'Dim propertyAccessor As Outlook.propertyAccessor  'This only works with 2007 and may help you out

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 StartRow As Integer

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

StartRow = InputBox("At which row should this start?", "Start Row", 4)

For Each c In Range("A" & StartRow & ":A" & CStr(EndRow))
    AliasName = LCase(Trim(c))
    c = AliasName
    Set myAddrEntries = myAddrList.addressEntries(AliasName)

    FullName = myAddrEntries.Name
    FirstName = Trim(Mid(FullName, InStr(FullName, "(") + 1, _
                    InStrRev(FullName, " ") - InStr(FullName, "(")))
    LastName = Right(FullName, Len(FullName) - InStrRev(FullName, " "))
    LastName = Left(LastName, Len(LastName) - 1)

    c.Offset(0, 1) = FirstName
    c.Offset(0, 2) = LastName
    c.Offset(0, 3) = FirstName & " " & LastName
Next c
End Sub

When I provide a single name (first or last) it looks for it in the address book and returns the first and last names of the person it found.

I want to provide the enterprise ID of the person, have it look for that and then return other information (location, phone number etc).

I can't figure out how to do that. First of all, I don't know how outlook knows to search only Alias, as far as I can tell that's only declared in local variables. Also, when I try to pull out other information, for example:

HomeState = myAddrEntries.HomeState

I get an error: Object doesn't support this property or method. I don't know what that property would be called - I couldn't find any doc online that showed how properties are named (even when I searched for MAPI docuemntation).

SO, my question is - how can I use this code to search by ID and return other properties such as location, number etc. ALso - how can I generalize that process - is there a list of what those field names are called, is there a way to generate a list?

Thanks!

Let's see if this can help you out. I am not an expert with Outlook VBA but it is mostly the same, and just a matter of finding the documentation.

Bookmark this page:

http://msdn.microsoft.com/en-us/library/office/ff870566(v=office.14).aspx

Specifically then you could look at the entry for AddressEntry object:

http://msdn.microsoft.com/en-us/library/office/ff870588(v=office.14).aspx

And from there you can see the list of available properties/methods. I believe that should answer your second question, I get an error: Object doesn't support this property or method. I don't know what that property would be called .

Homestate is not a property of an AddressEntry object.

When I provide a single name (first or last) it looks for it in the address book and returns the first and last names of the person it found.

Do not expect this to be 100% reliable

I tested this with 6 names and it got 4 of them right. 3 were rare last names. One was a full name which surprisingly returned wrong results. Your mileage may vary.

This will not work for any large organization. If you have a small address list, then perhaps it is easy to uniquely resolve based on a simple first/last name string. But otherwise, this is not reliable.

You have a few questions:

I want to provide the enterprise ID of the person, have it look for that and then return other information (location, phone number etc).

I do not think this is how Outlook resolves email addresses from an alias. You will need to reference some external database to perform a query like that.

I don't know how outlook knows to search only Alias, as far as I can tell that's only declared in local variables.

AliasName was a local variable in the example code, but it is assigned a value from user-input (cells in an Excel spreadsheet, for example). So the macro is reading in some values and attempting to resolve them against the address book.

As I mentioned above, this is only as good as the likelihood that a simple string will uniquely resolve to the correct individual.

Also, when I try to pull out other information, for example:

 HomeState = myAddrEntries.HomeState

I get an error: Object doesn't support this property or method. I don't know what that property would be called - I couldn't find any doc online that showed how properties are named (even when I searched for MAPI docuemntation).

Can there be a better solution???

Yes. Yes, there can.

If you dig around in the object model, you will find two items that look promising, GetContact method which returns a ContactItem (unfortunately this is not what we want), and GetExchangeUser which returns an ExchangeUser . I think this is the closest to what you want, since it contains much of the information you are looking for.

http://msdn.microsoft.com/en-us/library/office/ff870767(v=office.14).aspx

I modify your code as follows:

Option Explicit

Public Sub GetUsers()

Dim myolApp As Outlook.Application
Dim myNameSpace As Namespace
Dim myAddrList As AddressList
Dim myAddrEntry As addressEntry   'I changed this variable to avoid ambiguity
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 HomeState As String, PhoneNum As String
Dim StartRow As Integer

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

StartRow = InputBox("At which row should this start?", "Start Row", 4)

For Each c In Range("A" & StartRow & ":A" & CStr(EndRow))
    AliasName = LCase(Trim(c))
    c = AliasName
    Set myAddrEntry = myAddrList.addressEntries(AliasName)
    Set exchUser = myAddrEntry.GetExchangeUser
    
    If Not exchUser Is Nothing Then
        FirstName = exchUser.FirstName
        LastName = exchUser.LastName
        HomeState = exchUser.StateOrProvince
        PhoneNum = exchUser.BusinessTelephoneNumber
        'etc...
    End If

Next c
End Sub

To dramatically improve Outlook's reliability of looking up AliasName, especially in a large organization, I would cut off everything after last name and first name, such as department designation. This will work perfectly as long as no contacts are selected who share exact first and last names. No need to lowercase. Change this line:

Set myAddrEntries = myAddrList.addressEntries(AliasName)

into:

' Let's cut off everything after "last name, firstname " 
' get position of second blank in string

Dim Pos As Long

Pos = InStr(1, AliasName, " ", vbTextCompare)
Pos = InStr(Pos + 1, AliasName, " ", vbTextCompare)

If Pos > 0 Then
    Set myAddrEntry = myAddrList.addressEntries(Mid(AliasName, 1, Pos - 1))
Else
    Set myAddrEntry = myAddrList.addressEntries(AliasName)
End If

This may not be a complete answer to your question, but it's still an important part of the solution.

Straight up taking Microsofts code and adapting it to my excel sheet:

Sub DemoAE()

Dim colAL As outlook.AddressLists
Dim oAL As outlook.AddressList
Dim colAE As outlook.AddressEntries
Dim oAE As outlook.AddressEntry
Dim oExUser As outlook.ExchangeUser
Dim ws As Worksheet
Dim r As range
Set ws = application.ActiveWorkbook.Worksheets("Users")
Set r = ws.range("A2")
Set colAL = outlook.application.Session.AddressLists
TurnOff 'A function that turnsoff a bunch of memory hogging aspects of Excel when doing loops in sheets.

For Each oAL In colAL

'Address list is an Exchange Global Address List

If oAL.AddressListType = olExchangeGlobalAddressList Then
    Set colAE = oAL.AddressEntries
    For Each oAE In colAE
    If oAE.AddressEntryUserType = olExchangeUserAddressEntry Then
    Set oExUser = oAE.GetExchangeUser
        If oExUser.Alias <> "" And oExUser.PrimarySmtpAddress <> "" And oExUser.FirstName <> "" Then

            r = (oExUser.FirstName)
            r.Offset(0, 1) = (oExUser.LastName)
            r.Offset(0, 2) = (oExUser.Alias)
            r.Offset(0, 3) = (oExUser.PrimarySmtpAddress)
            If InStr(1, oExUser.Department, ",") <> 0 Then
                r.Offset(0, 4) = Left(oExUser.Department, InStr(1, oExUser.Department, ",") - 1)
            Else: r.Offset(0, 4) = oExUser.Department
            End If
        Set r = r.Offset(1, 0)
        End If
    End If
    Next

End If

Next
TurnOn 'A function that turns on a bunch of memory hogging aspects of Excel when not doing loops in sheets.

End Sub

Firstly, to resolve against all address books, use Namespace.CreateRecipient (eg Application.Session.CreateRecipient ) / Recipient.Resolve - if it returns true, Recipient.AddressEntry will (at the very least) contain valid AddressEntry.Name and Address properties (see AddressEntry object on MSDN). If the AddressEntry.AddressEntryUserType property is 0 ( olExchangeUserAddressEntry ), you can use AddressEntry.GetExchangeUser method that returns an instance of the ExchangeUser object. In your case, the property you want is StateOrProvince .

If the address entry corresponds to one of the items in the Contacts folder, AddressEntry.AddressEntryUserType will be 10 ( olOutlookContactAddressEntry ) and you can use the AddressEntry.GetContact() method to get an instance of the corresponding ContactItem object.

Keep in mind that if there are multiple matches, Outlook Object Model will throw an exception, there is no way to get the list of potential matches similar to the "Duplicate Names" dialog in Outlook unless you use Extended MAPI (C++ or Delphi only) or Redemption (any language). If using Redemption is an option, it exposes RDOAddressBook . ResolveNameEx and RDOAddressList . ResolveNameEx methods, which return a list of matches either against the whole address book ( RDOSession.AddressBook.ResolveNameEx ) or just the GAL container ( RDOSession.AddressBook.GAL.ResolveNameEx ):

set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set AdrrEntries = Session.AddressBook.ResolveNameEx("john")
for each AE in AdrrEntries
  MsgBox(AE.Name)
next

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM