Total Visual SourceBook

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 2007 and VB6

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

Separate version for Access/Office 2003, 2002, and 2000.

Separate version for:
Access 97/95


View all FMS products for Microsoft AccessAll Our Microsoft Access Products

SourceBook Info:

Why SourceBook?

 

"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

 

 

 

Microsoft Access, Office/VBA, VB6 Modules royalty-free source code libraryMicrosoft Access Modules royalty-free source code libraryMicrosoft Access VBA and VB6 Module Library Free trial of Total Visual SourceBook for Microsoft Access, Office, VB6 and VBA

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

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

Procedure List

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 Code for Using Class: OutlookContacts

' 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

Microsoft Access Module LibraryOverview of 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.

Additional Resources