Retrieving outlook contact details using VBA
Page 1 of 2 12 LastLast
Results 1 to 10 of 16

Thread: Retrieving outlook contact details using VBA
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Aug 2014
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Retrieving outlook contact details using VBA

    Hi,

    I have a list of names in a column in an Excel spreadsheet and I would like to get the person's phone number and email address from the global address list in Outlook. I have found a code online but I can't make it work. So far, I am testing this with only one cell (B9). I get a VBA error (objet variable not set) at line:

    phoneNumber = contact.BusinessTelephoneNumber

    I think that the problem is that contact = nothing, and I don't know what I did wrong.
    The code is located in the code space of the worksheet where the list of names is.

    Thanks in advance,
    NewB47
    Windows 7, Excel/Outlook 2010


    Code:

    Function GetNS(ByRef app As Outlook.Application) As Outlook.Namespace
    Set GetNS = app.GetNamespace("MAPI")
    End Function

    Function GetItems(olNS As Outlook.Namespace, folder As OlDefaultFolders) As Outlook.Items
    Set GetItems = olNS.GetDefaultFolder(folder).Items
    End Function

    Function GetOutlookApp() As Outlook.Application
    ' returns reference to native Application object
    Set GetOutlookApp = Outlook.Application
    End Function

    Sub Import_outlook_contact()
    Dim Outlook As Object
    Const olFolderContacts As Long = 10

    Dim contactName As String
    Dim contacts As Object
    Dim contact As Object
    Dim addressLists As Object ' Outlook.AddressLists
    Dim GAL As Object ' Outlook.AddressList
    Dim addressEntries As Object ' Outlook.AddressEntries
    Dim addressEntry As Object ' Outlook.AddressEntry

    Dim phoneNumber As String
    Dim emailAddress As String

    contactName = Range("B9").Value

    ' ignore blanks
    If Len(contactName) = 0 Then
    Exit Sub
    End If

    ' grab Outlook
    If Outlook Is Nothing Then
    Set Outlook = GetOutlookApp
    End If

    ' get contacts
    Set contacts = GetItems(GetNS(Outlook), olFolderContacts)

    ' grab target contact
    On Error Resume Next
    Set contact = contacts.Item(contactName)
    On Error GoTo 0

    ' try to find in GAL
    Set addressLists = GetNS(Outlook).addressLists
    Set GAL = addressLists.Item("Global Address List")
    Set addressEntries = GAL.addressEntries
    On Error Resume Next
    Set addressEntry = addressEntries.Item(contactName)
    On Error GoTo 0

    If addressEntry Is Nothing Then
    ' nothing in Contacts Folder or GAL
    MsgBox "No contact found with this name."
    Else
    ' in GAL but not Contacts Folder
    phoneNumber = contact.BusinessTelephoneNumber 'where I get problems: object variable not set
    emailAddress = contact.Email1Address
    End If

    ' put contact info into adjacent cell
    Application.EnableEvents = False
    Range("B9").Offset(0, 2).Value = phoneNumber
    Range("B9").Offset(0, 3).Value = emailAddress
    Application.EnableEvents = True

    End Sub

  2. #2
    MrExcel MVP Damon Ostrander's Avatar
    Join Date
    Feb 2002
    Location
    Denver, Colorado USA
    Posts
    4,239
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Retrieving outlook contact details using VBA

    Hi NewB47,

    It appears that the contact object variable did not get set because the contact named in cell B9 does not exist--at least not by that exact name. The name in B9 must exactly match the contact name.

    Damon

  3. #3
    New Member
    Join Date
    Aug 2014
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Retrieving outlook contact details using VBA

    Hi Damon,
    Thanks for your comment. I don't think that is problem because the address entry object works. In the end, I've solved this using:

    emailAddress = addressEntry.GetExchangeUser.PrimarySmtpAddress
    phoneNumber = addressEntry.GetExchangeUser.BusinessTelephoneNumber

  4. #4
    Board Regular
    Join Date
    Mar 2014
    Posts
    102
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Retrieving outlook contact details using VBA

    Hi There,

    I am trying to do quite the same as you except that I dont need thier phone numbers just the email. But the way the names are expressed in the name column of my worksheet, "SURNAME, Firstname".

    As I'm a complete beginner with VBA I do not follow how to tweak the above code. Could you please help me with this?

    Here's your code that I tried to fit my requirement.

    Remember the names are in column D and begin from the 4th row.

    Function GetNS(ByRef app As Outlook.Application) As Outlook.Namespace
    Set GetNS = app.GetNamespace("MAPI")
    End Function


    Function GetItems(olNS As Outlook.Namespace, folder As OlDefaultFolders) As Outlook.Items
    Set GetItems = olNS.GetDefaultFolder(folder).Items
    End Function


    Function GetOutlookApp() As Outlook.Application
    ' returns reference to native Application object
    Set GetOutlookApp = Outlook.Application
    End Function


    Sub Import_outlook_contact()
    Dim Outlook As Object
    Const olFolderContacts As Long = 10


    Dim contactName As String
    Dim contacts As Object
    Dim contact As Object
    Dim addressLists As Object ' Outlook.AddressLists
    Dim GAL As Object ' Outlook.AddressList
    Dim addressEntries As Object ' Outlook.AddressEntries
    Dim addressEntry As Object ' Outlook.AddressEntry


    Dim phoneNumber As String
    Dim emailAddress As String


    contactName = Range("D4").Value


    ' ignore blanks
    If Len(contactName) = 0 Then
    Exit Sub
    End If


    ' grab Outlook
    If Outlook Is Nothing Then
    Set Outlook = GetOutlookApp
    End If


    ' get contacts
    Set contacts = GetItems(GetNS(Outlook), olFolderContacts)


    ' grab target contact
    On Error Resume Next
    Set contact = contacts.Item(contactName)
    On Error GoTo 0


    ' try to find in GAL
    Set addressLists = GetNS(Outlook).addressLists
    Set GAL = addressLists.Item("Global Address List")
    Set addressEntries = GAL.addressEntries
    On Error Resume Next
    Set addressEntry = addressEntries.Item(contactName)
    On Error GoTo 0


    If addressEntry Is Nothing Then
    ' nothing in Contacts Folder or GAL
    MsgBox "No contact found with this name."
    Else
    ' in GAL but not Contacts Folder
    phoneNumber = contact.BusinessTelephoneNumber 'where I get problems: object variable not set
    emailAddress = contact.Email1Address
    End If


    ' put contact info into adjacent cell
    Application.EnableEvents = False
    Range("D4").Offset(0, 2).Value = emailAddress
    Application.EnableEvents = True


    End Sub

  5. #5
    New Member
    Join Date
    Aug 2014
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Retrieving outlook contact details using VBA

    Hi Reuben,

    Try this - this is was worked for me (leave the functions at the top). Your contacts should be written exactly the same as in the Outlook database (it's case sensitive) otherwise it will not work.

    Sub Import_outlook_contact()
    '-----------------------------------------------
    '------- Import outlook contact details -------
    '-----------------------------------------------
    Application.ScreenUpdating = False
    Dim Outlook As Object
    Const olFolderContacts As Long = 10

    Dim contactName(number of contacts you have) As String
    Dim addressLists As Object ' Outlook.AddressLists
    Dim GAL As Object ' Outlook.AddressList
    Dim addressEntries As Object ' Outlook.AddressEntries
    Dim addressEntry As Object ' Outlook.AddressEntry
    Dim emailAddress(number of contacts you have) As String

    For i = 1 To number of contacts you have
    contactName(i) = Range("D4").Offset(i - 1, 0).Value
    Next

    ' grab Outlook
    If Outlook Is Nothing Then
    Set Outlook = GetOutlookApp
    End If

    ' Find contacts in Global address list
    Set addressLists = GetNS(Outlook).addressLists
    Set GAL = addressLists.Item("Global Address List")
    Set addressEntries = GAL.addressEntries

    For i = 1 To number of contacts you have
    On Error Resume Next
    Set addressEntry = addressEntries.Item(contactName(i))
    On Error GoTo 0

    If contactName(i) <> "" Then 'skipping blanks
    If addressEntry.Name = contactName(i) Then
    ' contact in Global address list
    emailAddress(i) = addressEntry.GetExchangeUser.PrimarySmtpAddress
    Else
    ' contact not in Global address list
    MsgBox contactName(i) & " not found in directory. Full name is required."
    End If
    End If
    Next

    ' put contact info into adjacent cell
    Application.EnableEvents = False
    For i = 1 To number of contacts you have
    Range("D4").Offset(i - 1, 3).Value = emailAddress(i)
    Next

    Application.EnableEvents = True

    End Sub

  6. #6
    Board Regular
    Join Date
    Mar 2014
    Posts
    102
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Retrieving outlook contact details using VBA

    Quote Originally Posted by NewB47 View Post
    Hi Reuben,

    Try this - this is was worked for me (leave the functions at the top). Your contacts should be written exactly the same as in the Outlook database (it's case sensitive) otherwise it will not work.

    Sub Import_outlook_contact()
    '-----------------------------------------------
    '------- Import outlook contact details -------
    '-----------------------------------------------
    Application.ScreenUpdating = False
    Dim Outlook As Object
    Const olFolderContacts As Long = 10

    Dim contactName(number of contacts you have) As String
    Dim addressLists As Object ' Outlook.AddressLists
    Dim GAL As Object ' Outlook.AddressList
    Dim addressEntries As Object ' Outlook.AddressEntries
    Dim addressEntry As Object ' Outlook.AddressEntry
    Dim emailAddress(number of contacts you have) As String

    For i = 1 To number of contacts you have
    contactName(i) = Range("D4").Offset(i - 1, 0).Value
    Next

    ' grab Outlook
    If Outlook Is Nothing Then
    Set Outlook = GetOutlookApp
    End If

    ' Find contacts in Global address list
    Set addressLists = GetNS(Outlook).addressLists
    Set GAL = addressLists.Item("Global Address List")
    Set addressEntries = GAL.addressEntries

    For i = 1 To number of contacts you have
    On Error Resume Next
    Set addressEntry = addressEntries.Item(contactName(i))
    On Error GoTo 0

    If contactName(i) <> "" Then 'skipping blanks
    If addressEntry.Name = contactName(i) Then
    ' contact in Global address list
    emailAddress(i) = addressEntry.GetExchangeUser.PrimarySmtpAddress
    Else
    ' contact not in Global address list
    MsgBox contactName(i) & " not found in directory. Full name is required."
    End If
    End If
    Next

    ' put contact info into adjacent cell
    Application.EnableEvents = False
    For i = 1 To number of contacts you have
    Range("D4").Offset(i - 1, 3).Value = emailAddress(i)
    Next

    Application.EnableEvents = True

    End Sub
    Hi There,

    Thank you for your reply.

    I'm sorry if this sounds silly, but where do I get the 'number of contacts I have' from?

    Also, I would like this code to pull the contacts from two user IDs and mailboxes one is for me only and one is a shared mailbox (and that has a lot of contacts).

    Thanks.

  7. #7
    New Member
    Join Date
    Aug 2014
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Retrieving outlook contact details using VBA

    The 'number of contacts I have' is the number of contacts/lines you have in column D. If this number is changing, just use something like 500. The loop in the code is looking at one line after the other.

    This code pulls data from the global address list in outlook, no matter of who is logged on to outlook. If you work in a firm, all the firm contacts will be in that list. If you want to pull 'private' contacts, there's a way of doing that - pulling contacts from a folder in outlook - but I don't have the code for it. You can find it easily on the internet.

    Good luck.

  8. #8
    Board Regular
    Join Date
    Mar 2014
    Posts
    102
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Retrieving outlook contact details using VBA

    Hi there,

    thanks for your reply.

    I tried using the code with 500 as the number of contacts but when I run the module it gives a compile error Sub or Function not defined and has the yellow pointer of the debugger at - Sub Import_outlook_contact()

  9. #9
    New Member
    Join Date
    Aug 2014
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Retrieving outlook contact details using VBA

    Have you copied the 3 functions before the sub?
    The functions + the sub need to be in the VBA page of where your contacts are (ie: in Microsoft excel object and not in a module).

  10. #10
    Board Regular
    Join Date
    Mar 2014
    Posts
    102
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Retrieving outlook contact details using VBA

    Yes, I've added them in now but I still receive this error "User defined type not defined".

    Here's my code.

    Code:
    Function GetNS(ByRef app As Outlook.Application) As Outlook.Namespace
    Set GetNS = app.GetNamespace("MAPI")
    End Function
    
    
    Function GetItems(olNS As Outlook.Namespace, folder As OlDefaultFolders) As Outlook.Items
    Set GetItems = olNS.GetDefaultFolder(folder).Items
    End Function
    
    
    Function GetOutlookApp() As Outlook.Application
    ' returns reference to native Application object
    Set GetOutlookApp = Outlook.Application
    End Function
    
    
    Sub Import_outlook_contact()
    
    
    Application.ScreenUpdating = False
    Dim Outlook As Object
    Const olFolderContacts As Long = 10
    
    
    Dim contactName(500) As String
    Dim addressLists As Object ' Outlook.AddressLists
    Dim GAL As Object ' Outlook.AddressList
    Dim addressEntries As Object ' Outlook.AddressEntries
    Dim addressEntry As Object ' Outlook.AddressEntry
    Dim emailAddress(500) As String
    
    
    For i = 1 To 500
    contactName(i) = Range("D4").Offset(i - 1, 0).Value
    Next
    
    
    ' grab Outlook
    If Outlook Is Nothing Then
    Set Outlook = GetOutlookApp
    End If
    
    
    ' Find contacts in Global address list
    Set addressLists = GetNS(Outlook).addressLists
    Set GAL = addressLists.Item("Global Address List")
    Set addressEntries = GAL.addressEntries
    
    
    For i = 1 To 500
    On Error Resume Next
    Set addressEntry = addressEntries.Item(contactName(i))
    On Error GoTo 0
    
    
    If contactName(i) <> "" Then 'skipping blanks
    If addressEntry.Name = contactName(i) Then
    ' contact in Global address list
    emailAddress(i) = addressEntry.GetExchangeUser.PrimarySmtpAddress
    Else
    ' contact not in Global address list
    MsgBox contactName(i) & " not found in directory. Full name is required."
    End If
    End If
    Next
    
    
    ' put contact info into adjacent cell
    Application.EnableEvents = False
    For i = 1 To 500
    Range("D4").Offset(i - 1, 3).Value = emailAddress(i)
    Next
    
    
    Application.EnableEvents = True
    
    
    End Sub

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •