Chaplain Doug,
The following subroutine will iterate through your contacts list, identify
items that are distrubution lists rather than contacts, identify one named
"Chaplains" and then iterate through the members of the chaplains list. For
each member, it confirms that the address can be resolved and then it
searches the contacts folder for a match to the email address (only looking
at the primary email addy if there are several for a contact). It populates
sheet 1 with what it finds placing Full Name in column A, Email address in
Column B and Company Name in column C.
This does cause the annoying warning box to pop up. When I tested, I just
selected the option to allow access for one minute and then clicked yes.
For the small groups I tested it on the one minute was more than enough
time. This should be easy enough to marry up with your screening criteria
and mailing subroutine.
______________________________
Sub ListMembers()
Dim olApp As New Outlook.Application
Dim olNS As Outlook.Namespace
Dim ctFolder As Outlook.MAPIFolder
Dim myDistList As Outlook.DistListItem
Dim ctFolderItems As Outlook.Items
Dim myRcpnt As Outlook.Recipient
Dim iterateCtItems As Integer
Dim iterateMembers As Integer
Dim countCtItems As Integer
Dim countMembers As Integer
Dim R As Integer
Dim criteria As String
Dim itm As Object
Set olNS = olApp.GetNamespace("MAPI")
Set ctFolder = olNS.GetDefaultFolder(olFolderContacts)
Set ctFolderItems = ctFolder.Items
Sheets("Sheet1").UsedRange.Clear
countCtItems = ctFolderItems.Count
R = 1
For iterateCtItems = 1 To countCtItems
If TypeName(ctFolderItems.Item(iterateCtItems)) = "DistListItem" Then
Set myDistList = ctFolderItems.Item(iterateCtItems)
If myDistList.DLName = "Chaplains" Then
countMembers = myDistList.MemberCount
For iterateMembers = 1 To countMembers
Set myRcpnt =
olApp.Session.CreateRecipient(myDistList.GetMember(iterateMembers).Address)
myRcpnt.Resolve
If myRcpnt.Resolved = True Then
criteria = "[Email1Address] = " & myRcpnt.Address
Set itm = ctFolderItems.Find(criteria)
Sheets("Sheet1").Cells(R, 1).Value = itm.FullName
Sheets("Sheet1").Cells(R, 2).Value = itm.Email1Address
Sheets("Sheet1").Cells(R, 3).Value = itm.CompanyName
R = R + 1
End If
Next iterateMembers
End If
End If
Next iterateCtItems
Set olNS = Nothing
Set olApp = Nothing
End Sub
-------------------------------------------------
Steve Yandl
Chaplain Doug said:
Excel 2002. How would I programmatically access a distribution list in
Outlook from Excel. I need to run through the distribution list (called
"Chaplains"), examining their "company" and "email" fields, and send an
email
message to selected folks in the distribution list.
Another question. When I programmatically send mutiple Outlook emails
from
Excel (which I already know how to do), how do I keep Outlook from
prompting
me every time an email is sent? It prompts me that someone outside of
Outlook is trying to send a email. I already know this! How can I shut
this
off and turn it back on? Thanks.
