Outlook Distribution List creation 1

[MacroAlan]

Is it possible to create Distribution Lists in Outlook from Excel or Access thru VBA? Does anybody have any sample code to get me started.

Everything we have tried manually so far has been tedious. The list we have has 400+ employees broken down by many managers.

Thanks


Alan

 

[MazeWorX]

The short answer is yes but we require additional information how is this data stored? is it in a database or an excel sheet. how do you want your list organized? by manger , group?

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>

 

[MazeWorX]

Here is a starting point this code will create a distribution list from an excel sheet. It assumes you have First and last names on the sheet in columns A and B. they must match your contacts or an error will occur and the individual isn't added.
The code is a little clunky because it has to deal with MS development issues. simply it checks to see if outlook is open if not opens and make visible outlook prompts you for a distribution list name and then adds the names. You will need to save it in outlook

Public Sub DistributionList()
    Const ERR_APP_NOTRUNNING As Long = 429
    Dim objOutlook As New Outlook.Application
    Dim objNameSpace As Outlook.Namespace
    Dim objDistList As Outlook.DistListItem
    Dim objMail As Outlook.MailItem
    Dim objRecipients As Outlook.Recipients
    Dim wInbox As Outlook.MAPIFolder

    On Error Resume Next

    Set objOutlook = GetObject(, "Outlook.Application")
    If Err = ERR_APP_NOTRUNNING Then
        Set objOutlook = CreateObject("Outlook.Application")
    End If
    Set wInbox = objOutlook.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    wInbox.Display

    Set objDistList = objOutlook.CreateItem(olDistributionListItem)
    Set objMail = objOutlook.CreateItem(olMailItem)
    Set objRecipients = objMail.Recipients
    objDistList.DLName = InputBox("Enter name of Distribution List")
    'objDistList.DLName = "Test"

    For i = 1 To Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
        objRecipients.Add Trim((Range("A" & i).Value)) & " " & Trim((Range("B" & i).Value))
        Debug.Print Trim((Range("A" & i).Value)) & " " & Trim((Range("B" & i).Value))
    Next i

    objDistList.AddMembers objRecipients
    objDistList.Display
    objRecipients.ResolveAll

    Set objOutlook = Nothing
    Set objNameSpace = Nothing
    Set objDistList = Nothing
    Set objRecipients = Nothing

End Sub

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>

 

[MazeWorX]

ohh btw add this code to the excel sheet and make sure in the vbe editor you have referenced the Microsoft Outlook library

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>

 

[MacroAlan]

Thanks. I program in Access, Excel, and Outlook but could not fathom this issue since I couldn't how to do it manually. Since my customer is more comfortable in Excel, I will work from there.


Alan