none
OUTLOOK 2016, Listing All Contacts RRS feed

  • Question

  • I have a Word Userform where I previously listed all OUTLOOK contacts sorted by FileAs in a listbox. I recently upgraded to Office 2016. This morning I added a new contact to OUTLOOK. The contact is there and looks similar to the other contacts I have. However, when I attempt to create my contact list in Word that contact doesn't appear

    Here is the code.  Any idea why a new contact added with Outlook 2016 is not listed?

    Sub GetContacts(oFrm As Object)
    Dim oOutlookApp As Object 'Outlook.Application
    Dim m_bStart As Boolean
    Dim lsfrmAccount As frmAccount
    Dim objAddressBook As Object 'Outlook.AddressList
    Dim oContact As Object 'Outlook.ContactItem
    Dim oFld As Object 'Outlook.Folder
    Dim strContact As String
    Dim strAccount As String
    Dim strPropertValue As String
    Dim i As Long, j As Long
    Dim k As Long
    
    Dim varNames As Variant
    Dim varBDate As Variant
    
      On Error Resume Next
      Set oOutlookApp = GetObject(, "Outlook.Application")
      If oOutlookApp Is Nothing Then
        Set oOutlookApp = CreateObject("Outlook.Application")
        m_bStart = True
      End If
      On Error GoTo 0
      Set lsfrmAccount = New frmAccount
      With lsfrmAccount
        .ListAccounts.Clear
        For Each objAddressBook In oOutlookApp.Session.AddressLists
          If InStr(1, objAddressBook.Name, "(Mobile)") = 0 Then
            .ListAccounts.AddItem objAddressBook.Name
          End If
        Next
        .Show
        If .Tag = 0 Then
          Unload lsfrmAccount
          Exit Sub
        End If
        .Label1.Caption = "Select a listed contact"
        For i = 0 To .ListAccounts.ListCount - 1
          If .ListAccounts.ListIndex = i Then
            strAccount = .ListAccounts.List(i)
            Exit For
          End If
        Next i
        .ListAccounts.Clear
        For Each objAddressBook In oOutlookApp.Session.AddressLists
          If objAddressBook.Name = strAccount Then
            Debug.Print objAddressBook.Name
            Set oFld = objAddressBook.GetContactsFolder
            oFld.Items.Sort "[FileAs]", False
            For Each oContact In oFld.Items
              On Error GoTo Err_ContactI
              .ListAccounts.AddItem oContact.FileAs
            Next oContact
          Exit For
        End If
    Err_Contact_ReentryI:
        Next objAddressBook
        strPropertValue = ""
        DoEvents
        .Show
        If .ListAccounts.ListIndex <> -1 Then
          strContact = .ListAccounts.List(.ListAccounts.ListIndex)
          Set oContact = oFld.Items.Find("[FileAs]=" & Chr(34) & strContact & Chr(34))
          On Error Resume Next
          With oFrm
            'Debug.Print oContact.City
            .AddresseeBox.Text = oContact.FullName
            .txtCity.Text = oContact.MailingAddressCity
            .TitleBox = oContact.JobTitle
            .CompanyBox.Text = oContact.CompanyName
            .AddressBox.Text = oContact.MailingAddress
            .DearBox.Text = oContact.UserProperties.Item("Nickname").Value
            .NameTrust.Text = oContact.UserProperties.Item("NameTrust").Value
            .DateTrust.Text = oContact.UserProperties.Item("DateTrust").Value
            .Partner1.Text = oContact.UserProperties.Item("Partner1").Value
            .SalPart1.Text = oContact.UserProperties.Item("SalPart1").Value
             .Partner2.Text = oContact.UserProperties.Item("Partner2").Value
            .SalPart2.Text = oContact.UserProperties.Item("SalPart2").Value
            .SucTrustee.Text = oContact.UserProperties.Item("SucTrustee").Value
            .Nochildren.Text = oContact.UserProperties.Item("NoChildren").Value
            varNames = oContact.UserProperties.Item("Children").Value
            For i = 0 To UBound(varNames)
              If i = 0 Then
                .ChildrenNames.Text = varNames(i)
              Else
                .ChildrenNames.Text = .ChildrenNames.Text & " , " & varNames(i)
              End If
            Next i
            varBDate = oContact.UserProperties.Item("BirthdatesChildren").Value
           
          
                .BirthdatesChildren.Text = varBDate
         
          End With
          On Error GoTo 0
        End If
      End With
      Unload lsfrmAccount
      Set lsfrmAccount = Nothing
      Set oOutlookApp = Nothing
      Set objAddressBook = Nothing
      Set oContact = Nothing
    lbl_Exit:
      Exit Sub
    Err_ContactI:
      Resume Err_Contact_ReentryI
    End Sub
    


    Greg Maxey Please visit my website at: http://gregmaxey.mvps.org/word_tips.htm

    Tuesday, October 20, 2015 11:46 AM

Answers

  • Eugene,

    Thanks for your reply!  I looked at this on lunch break today and discovered that I only have one address book and it is the Contacts folder.  The problem was partly my own fault (due to error handler).  One of the items (the item just before the new contact I added today) is a distribution list.  When the For loop hit that item and this line:

    .ListAccounts.AddItem oContact.FileAs  the error was triggered and the new contact was simply never process.

    Sorted out now.  Thanks again.


    Greg Maxey Please visit my website at: http://gregmaxey.mvps.org/word_tips.htm

    Tuesday, October 20, 2015 11:20 PM

All replies

  • Hello Greg,

    I have noticed the following code:

    For Each objAddressBook In oOutlookApp.Session.AddressLists
      If InStr(1, objAddressBook.Name, "(Mobile)") = 0 Then
         .ListAccounts.AddItem objAddressBook.Name
      End If
    

    Looks like your new contact doesn't belong to one of the "Mobile" address books. Try to search Contacts folder too, see Store.GetDefaultFolder method to get the Contacts folder for each store. This method is similar to the GetDefaultFolder method of the NameSpace object. The difference is that this method gets the default folder on the delivery store that is associated with the account, whereas NameSpace.GetDefaultFolder returns the default folder on the default store for the current profile.

    Finally, you may find the Getting Started with VBA in Outlook 2010 article helpful.

    Tuesday, October 20, 2015 12:00 PM
  • Eugene,

    Thanks for your reply!  I looked at this on lunch break today and discovered that I only have one address book and it is the Contacts folder.  The problem was partly my own fault (due to error handler).  One of the items (the item just before the new contact I added today) is a distribution list.  When the For loop hit that item and this line:

    .ListAccounts.AddItem oContact.FileAs  the error was triggered and the new contact was simply never process.

    Sorted out now.  Thanks again.


    Greg Maxey Please visit my website at: http://gregmaxey.mvps.org/word_tips.htm

    Tuesday, October 20, 2015 11:20 PM