' ========================================================================================================================
' ____,__, __, ____,_, _, ____ ____,__, ,____,____,
' (-/_|(-| (-| (-|_,(-|\ | (-|__|-/_|( |_/(-|_,(-|__)
' _/ |,_|__,_|__,_|__,_| \|, _|__)/ |,_| \,_|__,_| \,
'
' 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
Copyright © 2012 Allen Baker
|