VBA – Extract Outlook Contacts

contact information

Once again, helping out with a forum question regarding the very limited information returned when using the External Data -> Import & Link -> More -> Outlook Folder. So, as per the usual, VBA give you the power to do it all and that is true when interacting with Outlook and Outlook Contacts. Below is the beginning of a procedure to extract any and all information from the Contacts folder.

'---------------------------------------------------------------------------------------
' Procedure : Outlook_ExtractContacts
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Extract contact information from Outlook
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Usage:
' ~~~~~~
' Call Outlook_ExtractContacts
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2019-07-15              Initial Release - Forum Help
'---------------------------------------------------------------------------------------
Sub Outlook_ExtractContacts()
    Dim oOutlook              As Object    'Outlook.Application
    Dim oNameSpace            As Object    'Outlook.Namespace
    Dim oFolder               As Object    'Outlook.folder
    Dim oItem                 As Object
    Dim oPrp                  As Object
    Const olFolderContacts = 10
    Const olContact = 40

    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")        'Bind to existing instance of Outlook
    If Err.Number <> 0 Then        'Could not get instance, so create a new one
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo Error_Handler

    Set oNameSpace = oOutlook.GetNamespace("MAPI")
    Set oFolder = oNameSpace.GetDefaultFolder(olFolderContacts)

    On Error Resume Next
    For Each oItem In oFolder.Items
        With oItem
            If .Class = olContact Then
                Debug.Print .EntryId, .FullName, .FirstName, .LastName, .CompanyName
                For Each oPrp In .ItemProperties
                    Debug.Print , oPrp.Name, oPrp.Value
                Next oPrp
            End If
        End With
    Next oItem

Error_Handler_Exit:
    On Error Resume Next
    If Not oPrp Is Nothing Then Set oPrp = Nothing
    If Not oItem Is Nothing Then Set oItem = Nothing
    If Not oFolder Is Nothing Then Set oFolder = Nothing
    If Not oNameSpace Is Nothing Then Set oNameSpace = Nothing
    If Not oOutlook Is Nothing Then Set oOutlook = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Outlook_ExtractContacts" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

I use On Error Resume Next to be able to iterate through all the ItemProperties without it crashing my code (to show you what information is actually available to you). But if you are only after select fields, then you are better to simply specify those particular field like I did in the line

Debug.Print .EntryId, .FullName, .FirstName, .LastName, .CompanyName
Other Useful Links Relative to this Subject

5 responses on “VBA – Extract Outlook Contacts

  1. azer

    Hi Daniel, instead of the debug print
    could you offer us the code to insert the data in a table?
    for instance tabContact and in the fields EntryId, FullName, FirstName, LastName, CompanyName

    also , is there a chance you would do same type of code for firebird instead of outlook in futur ?

    thanks again for your generosity, my overall pleasure to use access is due to the implementation of your shared work <3

  2. Paul

    something like this works…

    SQL = “insert into tmp_OUTLOOK_CONTACT(EntryID, FirstName, LastName, JobTitle, CompanyName, Department, Email1Address, Email2Address” _
    & “, Email3Address, BusinessAddressStreet, BusinessAddressPostOfficeBox, BusinessAddressCity, BusinessAddressState, ” _
    & ” BusinessAddressPostalCode, CompanyMainTelephoneNumber, BusinessTelephoneNumber, MobileTelephoneNumber, ” _
    & ” PrimaryTelephoneNumber, BusinessFaxNumber, WebPage, CreationTime, LastModificationTime) values(”
    SQL = SQL & Chr(34) & .EntryID & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .FirstName & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .LastName & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .JobTitle & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .CompanyName & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .Department & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .Email1Address & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .Email2Address & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .Email3Address & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .BusinessAddressStreet & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .BusinessAddressPostOfficeBox & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .BusinessAddressCity & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .BusinessAddressState & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .BusinessAddressPostalCode & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .CompanyMainTelephoneNumber & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .BusinessTelephoneNumber & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .MobileTelephoneNumber & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .PrimaryTelephoneNumber & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .BusinessFaxNumber & Chr(34) & “, ”
    SQL = SQL & Chr(34) & .WebPage & Chr(34) & “, ”
    SQL = SQL & “#” & .CreationTime & “#, ”
    SQL = SQL & “#” & .LastModificationTime & “#);”

    CurrentDb.Execute SQL, dbFailOnError

  3. Marcus

    Hello Daniel,

    thanks again for your great work. On your site I usually find a solution or an approach to my problem. Only for what I’m looking for right now I have not found. Because I don’t want to extract or import the Outlook contacts. I want to create a linked table to the Outlook contacts. Manually this is possible. However, I have not yet found a solution anywhere on how to do this via VBA. At least calling the “Import Exchange/Outlook Wizard” via VBA would already be a success.

    Do you have a solution for this?

    1. Daniel Pineault Post author

      You should be able to do so manually via

      External Data -> More -> Outlook Folder

      Then follow the wizard steps.

      I’ve never need to automate this, so I don’t have any VBA code handy, but it’s most probably possible via code as well.

      Do note, that there can be certain limitations with such linked tables, this is why I personally usually use VBA to work with Outlook data, but for basic usage it works just fine.