Class: OutlookContacts in Category Microsoft Outlook : Automation from Total Visual SourceBook

Working with Microsoft Outlook Contacts through Automation using VBA and VB6.

Procedure Name Type Description
(Declarations) Declarations Declarations and private variables for the COutlookContacts class.
AppFolder Property Get a handle to the current instance of Outlook Contacts folder.
AppNameSpace Property Get a handle to the current instance of the Outlook NameSpace.
AppOutlook Property Get a handle to the current instance of Outlook.
BusinessAddressCity Property Set the value of the BusinessAddressCity Property.
BusinessAddressCountry Property Set the value of the BusinessAddressCountry Property.
BusinessAddressPostalCode Property Set the value of the BusinessAddressPostalCode Property.
BusinessAddressState Property Set the value of the BusinessAddressState Property.
BusinessAddressStreet Property Set the value of the BusinessAddressStreet Property.
BusinessFax Property Set the value of the BusinessFax Property.
BusinessPhone Property Set the value of the BusinessPhone Property.
Company Property Set the value of the Company Property.
EMail Property Set the value of the Email Property.
FileAs Property Set the value of the FileAs Property.
FirstName Property Set the value of the FirstName Property.
HomeAddressCity Property Set the value of the HomeAddressCity Property.
HomeAddressCountry Property Set the value of the HomeAddressCountry Property.
HomeAddressPostalCode Property Set the value of the HomeAddressPostalCode Property.
HomeAddressState Property Set the value of the HomeAddressState Property.
HomeAddressStreet Property Set the value of the HomeAddressStreet Property.
HomePhone Property Set the value of the HomePhone Property.
JobTitle Property Set the value of the JobTitle Property.
LastName Property Set the value of the LastName Property.
MiddleName Property Set the value of the MiddleName Property.
MobilePhone Property Set the value of the MobilePhone Property.
PagerNumber Property Set the value of the PagerNumber Property.
Suffix Property Set the value of the Suffix Property.
Title Property Set the value of the Title Property.
AddContact Method Adds a Contact to the Contacts folder.
AddDistList Method Create a new Distribution List.
GetContactsAll Method Get a list of all Contacts from the Contacts folder.
ReplaceCompanyName Method Change the company name of all contacts from one name to a new name. Use this procedure as an example of changing any Contact property.
DeleteContactsByNameCompanyEmail Method Delete Contacts filtered by name, company, and/or email address.
GetContactsByNameCompanyEmail Method Get a list of Contacts from the Contacts folder for a particular name, company, and/or email address.
GetContactsByFilter Method Get a list of Contacts from the Contacts folder that match the specified filter.
GetContactItem Method Get the first contact item that satisfies the specified criteria. With the item, you can edit its properties directly.
GetContactFilter Private Create the filter string to limit the contact items.
StartOutlook Method Starts an instance of Outlook.
Class_Terminate Terminate Clean up class variables opened for Outlook.
CloseOutlook Method Close an instance of Outlook; don't call this if you want to leave Outlook open.
' Example of the COutlookContacts class
'
' To use this example:
' 1.  Create a new form.
' 2.  Create the following command buttons:
'         cmdAddContact
'         cmdAddDistList
'         cmdGetContacts
'         cmdGetContactsFiltered
'         cmdDisplayContact
'         cmdEditContact
'         cmdRenameCompany
'         cmdDeleteContact
' 3.  Create the following text fields:
'         txtTitle
'         txtFirstName
'         txtLastName
'         txtStreet
'         txtCity
'         txtState
'         txtZip
'         txtCountry
'         txtHomePhone
'         txtBusine ssPhone
'         txtFileAs
'         txtEmail
'         txtJobTitle
'         txtCompany
'         txtAddressType
' 4. Run the form

Private Sub cmdAddContact_Click()
  ' Add a contact

  Dim olkContact As COutlookContacts

  If MsgBox("Do you really want to add this contact: " & vbCrLf & Me.txtFirstName & " " & Me.txtLastName & vbCrLf & Me.txtCompany, vbYesNo) = vbYes Then

    Set olkContact = New COutlookContacts

    With olkContact
      .StartOutlook

      .Title = Nz(txtTitle, "")
      .JobTitle = Nz(txtJobTitle, "")
      .Company = Nz(txtCompany, "")
      .HomePhone = Nz(txtHomePhone, "")
      .BusinessPhone = Nz(txtBusinessPhone, "")
      .EMail = Nz(txtEmail, "")
      .FileAs = Nz(txtFileAs, "")
      .FirstName = Nz(txtFirstName, "")
      .LastName = Nz(txtLastName, "")
      .BusinessAddressStreet = Nz(txtStreet, "")
      .BusinessAddressCity = Nz(txtCity, "")
      .BusinessAddressPostalCode = Nz(txtZip, "")
      .BusinessAddressState = Nz(txtState, "")
      .BusinessAddressCountry = Nz(txtCountry, "")

      ' Add the contact
      .AddContact True

    End With

    ' Clean up
    Set olkContact = Nothing
  End If

End Sub

Private Sub cmdAddDistList_Click()
  ' Add a distribution list to Contacts

  Dim olkContact As COutlookContacts

  Dim strDistListName As String
  Dim strMembers As String

  strDistListName = InputBox("Enter the name of the new distribution list:", "Add Distribution List", "TVSB Test List")
  strMembers = InputBox("Enter the email addresses to add to the list (separated by commas):", "Add Distribution List", "fms@fmsinc.com, support@fmsinc.com")

  Set olkContact = New COutlookContacts
  olkContact.StartOutlook
  olkContact.AddDistList strDistListName, strMembers, ",", True

End Sub

Private Sub cmdDeleteContact_Click()
  ' Delete contacts that meet your criteria

  Dim strEmail As String
  Dim olkContact As COutlookContacts
  Dim lngCount As Long

  strEmail = InputBox("Enter the email address for the contacts to delete:")

  If strEmail <> "" Then
    Set olkContact = New COutlookContacts

    olkContact.StartOutlook

    lngCount = olkContact.DeleteContactsByNameCompanyEmail(strEmail:=strEmail)

    If lngCount = 0 Then
      MsgBox "No contacts were deleted for " & strEmail
    Else
      MsgBox lngCount & " contacts were deleted for " & strEmail
    End If

    ' Clean up
    Set olkContact = Nothing
  End If

End Sub

Private Sub cmdDisplayContact_Click()
  ' Get and display the first contact of a company filter

  Dim strCompanyFilter As String
  Dim olkContact As COutlookContacts
  Dim outContact As Outlook.ContactItem

  strCompanyFilter = InputBox("Enter the Company name to get its first contact: ")

  If strCompanyFilter <> "" Then
    Set olkContact = New COutlookContacts
    olkContact.StartOutlook

    Set outContact = olkContact.GetContactItem(True, , , , strCompanyFilter)

    If outContact Is Nothing Then
      MsgBox "No contacts found for " & strCompanyFilter
    Else
      With outContact
        Debug.Print "This contact was found " & .FullName & " at " & .CompanyName & " with email " & .Email1Address & " and business phone " & .BusinessTelephoneNumber
      End With
    End If

    ' Clean up
    Set outContact = Nothing
    Set olkContact = Nothing
  End If

End Sub

Private Sub cmdEditContact_Click()
  ' By getting a specific contact item, you can update its properties.
  ' This example retrieves a contact based on its email address, then gives you the option to update it.

  Dim strCompanyFilter As String
  Dim olkContact As COutlookContacts
  Dim outContact As Outlook.ContactItem
  Dim strMsg As String
  Dim strEmail As String

  strEmail = InputBox("Enter the email address of your contact: ")

  If strEmail <> "" Then
    Set olkContact = New COutlookContacts
    olkContact.StartOutlook

    ' Find the contact, but do not display it if it's found
    Set outContact = olkContact.GetContactItem(False, , , , strEmail)

    If outContact Is Nothing Then
      MsgBox "No contacts found for " & strCompanyFilter
    Else
      With outContact
        strMsg = "This contact was found " & .FullName & " at " & .CompanyName & " with email " & .Email1Address
        strMsg = strMsg & vbCrLf & vbCrLf & "Would you like to update the email address?"
        If MsgBox(strMsg, vbYesNo) = vbYes Then
          strEmail = InputBox("Enter the new email address:", , .Email1Address)
          If strEmail <> "" Then
            .Email1Address = strEmail
            .Save
            MsgBox "Contact updated"
          End If
        End If
      End With
    End If

    ' Clean up
    Set outContact = Nothing
    Set olkContact = Nothing
  End If

End Sub

Private Sub cmdGetContacts_Click()
  ' Display all contacts

  Dim olkContact As COutlookContacts
  Dim colContacts As Collection
  Dim lngCount As Long

  Set olkContact = New COutlookContacts

  olkContact.StartOutlook

  Set colContacts = olkContact.GetContactsAll

  For lngCount = 1 To colContacts.Count
    With colContacts(lngCount)
      Debug.Print lngCount, .FirstName, .LastName, .CompanyName
    End With
  Next lngCount

  If colContacts.Count > 0 Then
    MsgBox colContacts.Count & " contacts found. They are listed in Immediate Window."
  Else
    MsgBox "No contacts found"
  End If

  ' Clean up
  Set olkContact = Nothing
  Set colContacts = Nothing

End Sub

Private Sub cmdGetContactsFiltered_Click()
  ' Filter the list of contacts by company and display them

  Dim strCompanyFilter As String
  Dim olkContact As COutlookContacts
  Dim colContacts As Collection
  Dim lngCount As Long

  ' Get the company name to filter on
  strCompanyFilter = InputBox("Enter the Company name to get contacts for: ")
  If strCompanyFilter <> "" Then
    Set olkContact = New COutlookContacts

    olkContact.StartOutlook

    Set colContacts = olkContact.GetContactsByNameCompanyEmail(True, strCompany:=strCompanyFilter)

    ' Example of filtering on one property
    Set colContacts = olkContact.GetContactsByFilter(True, "CompanyName", strCompanyFilter)

    If colContacts.Count = 0 Then
      MsgBox "No contacts match for " & strCompanyFilter
    Else
      MsgBox colContacts.Count & " contacts found. Also listed in the Immediate Window."
      For lngCount = 1 To colContacts.Count
        With colContacts(lngCount)
          Debug.Print .FirstName, .LastName, .CompanyName, .Email1Address
        End With
      Next lngCount
    End If

    ' Clean up
    Set olkContact = Nothing
    Set colContacts = Nothing
  End If

End Sub

Private Sub cmdRenameCompany_Click()
  ' Rename the company name for all contacts from one to another
  ' This is an easy way to make company names consistent across your contacts.
  ' For instance, you may want to change all "Microsoft" contacts to "Microsoft Corporation" or vice versa

  Dim strCompany As String
  Dim strNewCompany As String
  Dim olkContact As COutlookContacts
  Dim lngCount As Long

  ' Use "Get Filtered Contacts" to return a list of contacts with the specified company name
  strCompany = InputBox("Enter the Company name to get contacts for:")
  If strCompany <> "" Then
    strNewCompany = InputBox("Enter the New Company name:")
    If strNewCompany <> "" Then
      Set olkContact = New COutlookContacts

      olkContact.StartOutlook

      lngCount = olkContact.ReplaceCompanyName(strCompany, strNewCompany)

      If lngCount = 0 Then
        MsgBox "No contacts were updated for " & strCompany
      Else
        MsgBox lngCount & " contacts were updated"
      End If

      ' Clean up
      Set olkContact = Nothing
    End If
  End If

End Sub

Private Sub Form_Load()
  ' Setup controls

  Me.cmdAddContact.Caption = "Add contact"
  Me.cmdAddDistList.Caption = "Add Dist List"
  Me.cmdGetContacts.Caption = "List all contacts"
  Me.cmdGetContactsFiltered.Caption = "List Filtered Contacts"
  Me.txtAddressType = "BUSINESS"
  Me.txtAddressType.Enabled = "False"
  Me.txtBusinessPhone = "703-356-4700"
  Me.txtCompany = "FMS, Inc."
  Me.txtCountry = "United States"
  Me.txtEmail = "fms@fmsinc.com"
  Me.txtFileAs = "FMS, Inc."
  Me.txtFirstName = "FMS"
  Me.txtHomePhone = "703-356-4700"
  Me.txtJobTitle = "World Class Software Solutions"
  Me.txtLastName = "Inc."
  Me.txtStreet = "8150 Leesburg Pike"
  Me.txtTitle = ""
  Me.txtCity = "Vienna"
  Me.txtState = "VA"
  Me.txtZip = "22182"

End Sub

Total Visual SourceBook The source code in Total Visual Sourcebook includes modules and classes for Microsoft Access, Visual Basic 6 (VB6), and Visual Basic for Applications (VBA) developers. Easily add this professionally written, tested, and documented royalty-free code into your applications to simplify your application development efforts.

Total Visual SourceBook is written for the needs of a developer using a source code library covering the many challenges you face. Countless developers over the years have told us they learned some or much of their development skills and tricks from our code. You can too!

Additional Resources

Total Visual SourceBook CD and Printed Manual

Microsoft Access/ Office 2016, 2013, 2010, and 2007 Version
is Shipping!

New features in Total Visual SourceBook for Access, Office and VB6

Supports Access/Office 2016, 2013, 2010 and 2007, and Visual Basic 6.0!


View all FMS products for Microsoft Access All Our Microsoft Access Products

Reviews

Reader Choice Award for MS Access Source Code Library
Reader Choice

"The code is exactly how I would like to write code and the algorithms used are very efficient and well-documented."

Van T. Dinh, Microsoft MVP

SourceBook Info

Additional Info

Question

 

 

Free Product Catalog from FMS