image
 
image
M013_OutlookUtils.bas


' ========================================================================================================================
'                                 ____,__,  __,  ____,_,  _,  ____ ____,__, ,____,____,
'                                (-/_|(-|  (-|  (-|_,(-|\ |  (-|__|-/_|( |_/(-|_,(-|__)
'                                _/  |,_|__,_|__,_|__,_| \|,  _|__)/  |,_| \,_|__,_|  \,
'
'                                             Copyright 2012 Allen Baker
'
' ------------------------------------------------------------------------------------------------------------------------
' File:          M013_OutlookUtils
' Originator:    Allen Baker (2012.02.17 17:06)
' ------------------------------------------------------------------------------------------------------------------------
' $RCSfile$
' $Revision$
' $Date$
' ========================================================================================================================
'
Option Explicit



' ========================================================================================================================
' Description
'    This module provides miscellaneous utility routines and functions that operate on Outlook objects and variables.
' ========================================================================================================================



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Constants  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



Public Const cEmailAddressNotFound As String = "NOT FOUND"



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Module Variables  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Public Routines  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function finds and returns the SMTP email address for pName
'
' return
'    This returns the SMTP email address for pName or cEmailAddressNotFound if it cannot find an email
'    address for pName
'
' param
'    pName is the name to find an email address for
' -----------------------------------------------------------------------------------------------------------
Public Function outlookEmailAddress(pName As String) As String
    Dim outlookApplication      As Object
    Dim outlookRecipient        As Outlook.Recipient
    Dim outlookExchangeUser     As Outlook.ExchangeUser
    Dim outlookDistributionList As Outlook.ExchangeDistributionList
   '
   ' ==============================================================================================
   ' default return value if we cannot resolve the name
   ' ----------------------------------------------------------------------------------------------
    outlookEmailAddress = cEmailAddressNotFound
   '
   ' ==============================================================================================
   ' resolve the name
   ' ----------------------------------------------------------------------------------------------
    Set outlookApplication = CreateObject("Outlook.Application")
    Set outlookRecipient = outlookApplication.Session.CreateRecipient(pName)
    outlookRecipient.Resolve
    If outlookRecipient.Resolved Then
        Select Case outlookRecipient.AddressEntry.AddressEntryUserType
            Case OlAddressEntryUserType.olExchangeUserAddressEntry
                Set outlookExchangeUser = outlookRecipient.AddressEntry.GetExchangeUser
                If Not (outlookExchangeUser Is Nothing) Then
                    outlookEmailAddress = outlookExchangeUser.PrimarySmtpAddress
                End If
            Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
                Set outlookDistributionList = outlookRecipient.AddressEntry.GetExchangeDistributionList
                If Not (outlookDistributionList Is Nothing) Then
                    outlookEmailAddress = outlookDistributionList.PrimarySmtpAddress
                End If
        End Select
    End If
End Function



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Private Routines  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



''
'' =====================================================================================================================
'' =====================================================================================================================
'' =====================================================================================================================
'' This routine
'' -----------------------------------------------------------------------------------------------------------
'Private Sub example_findEmailAddressOfEveryoneInMyContactsList()
'   Dim outlookApplication As Outlook.Application
'   Dim outlookNameSpace As Outlook.Namespace
'   Dim outlookAddressList As Outlook.AddressList
'   Dim outlookAddressEntry As AddressEntry
'   Dim rowIdx As Long
'   Dim addressEntryName As String
'   Dim addressEntryEmailAddress As String
'
'   Set outlookApplication = CreateObject("Outlook.Application")
'   Set outlookNameSpace = outlookApplication.GetNameSpace("MAPI")
'   Set outlookAddressList = outlookNameSpace.AddressLists("Contacts")
'   rowIdx = 1
'   For Each outlookAddressEntry In outlookAddressList.AddressEntries
'      addressEntryName = outlookAddressEntry.name
'      addressEntryEmailAddress = ResolveDisplayNameToSMTP(outlookAddressEntry.name)
'      rowIdx = rowIdx + 1
'   Next outlookAddressEntry
'End Sub