asked on

Create & Update Outlook Distribution Lists from Access Database

Dear Experts,

I need a way to create & update groups (distribution lists) in outlook 2010 from Access 2010.

Basically I'm building a membership database. There are a variety of different membership types and distribution lists that will be managed from Access & these need to be translated into outlook Groups.

So for example in access Jo Bloggs is a "Committee Member" & also wants to hear about "Tech News" - this means in outlook he will be part of 2 Groups: "Committee Member" & "Tech News".

Where I am stuck is how to add or remove people within the various outlook groups from Access.

Any ideas?

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

Tom Crowfoot

ASKER

Fantastic - thank you for that - works a treat. Posted below is the final code from that link:

Private Sub AList_AfterUpdate()
On Error Resume Next

    Dim myOlApp As New Outlook.Application
    Dim myNameSpace As Outlook.NameSpace
    Dim myDistList As Outlook.DistListItem
    Dim myTempItem As Outlook.MailItem
    Dim myRecipients As Outlook.Recipients
    Dim objcontacts As Outlook.MAPIFolder
    Dim objcontact As Outlook.ContactItem
    Dim myid, myname As String
    
If Me.AList = True Then 'if true add, if not remove

    'check to see if list already exists
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set objcontacts = myNameSpace.GetDefaultFolder(olFolderContacts)
    Set myDistList = objcontacts.Items("" & Me.Label273.Caption)
    If Err.Number = -2147221233 Then
    GoTo Createmylist
    Err.Clear
    Else
    GoTo addtolist
    End If
    Exit Sub
    
    
Createmylist:
    myid = Me.IDContact
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set myTempItem = myOlApp.CreateItem(olMailItem)
    Set myRecipients = myTempItem.Recipients
    Set objcontacts = myNameSpace.GetDefaultFolder(olFolderContacts)
    Set objcontact = objcontacts.Items.Find("[user1] =" & myid)
    Set myDistList = myOlApp.CreateItem(olDistributionListItem)
    
    myname = objcontact.FullName
    myDistList.DLName = "" & Me.Label273.Caption
    myRecipients.Add "" & myname
    myRecipients.ResolveAll
    myDistList.AddMembers myRecipients
    myDistList.Close olSave
    GoTo mycleanup
    
    
addtolist:
    myid = Me.IDContact
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set myTempItem = myOlApp.CreateItem(olMailItem)
    Set myRecipients = myTempItem.Recipients
    Set objcontacts = myNameSpace.GetDefaultFolder(olFolderContacts)
    Set objcontact = objcontacts.Items.Find("[user1] =" & myid)
    Set myDistList = objcontacts.Items("" & Me.Label273.Caption)

    myname = objcontact.FullName
    myRecipients.Add "" & myname
    myRecipients.ResolveAll
    myDistList.AddMembers myRecipients
    myDistList.Close olSave
   GoTo mycleanup
   
Else ' remove in unchecked

'check to see if list already exists
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set objcontacts = myNameSpace.GetDefaultFolder(olFolderContacts)
    Set myDistList = objcontacts.Items("" & Me.Label273.Caption)
    If Err.Number = -2147221233 Then
    Err.Clear
    Exit Sub
    Else
    myid = Me.IDContact
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set myTempItem = myOlApp.CreateItem(olMailItem)
    Set myRecipients = myTempItem.Recipients
    Set objcontacts = myNameSpace.GetDefaultFolder(olFolderContacts)
    Set objcontact = objcontacts.Items.Find("[user1] =" & myid)
    Set myDistList = objcontacts.Items("" & Me.Label273.Caption)
    End If

    myname = objcontact.FullName
    myRecipients.Add "" & myname
    myRecipients.ResolveAll
    myDistList.RemoveMembers myRecipients
    myDistList.Close olSave
   
   
   'check to see if list is populated, delete if empty
   If myDistList.MemberCount = 0 Then
   myDistList.Delete
   End If
   

End If


mycleanup:
    Set myOlApp = Nothing
    Set myNameSpace = Nothing
    Set myDistList = Nothing
    Set myTempItem = Nothing
    Set myRecipients = Nothing
    Set objcontacts = Nothing
    Set objcontact = Nothing
    
    
End Sub

Open in new window

Tom Crowfoot

ASKER

Brilliant - thank you very much - works a treat

Create &amp; Update Outlook Distribution Lists from Access Database

Create & Update Outlook Distribution Lists from Access Database