Question about nested distribution lists

[Moragtao]

Is there any way I can, with a macro, create a nested distribution list with the info in an excel sheet? Basically, I have a sheet where column A is the name for the nested distlist, and then columns B-F have the names of the distlists that should go into the nested one. Currently, the macro I have written can create and save the distlist, but can't seem to resolve when I'm trying to add the other distlists to it.



Don't judge this code too harshly, I've never done something like this before so a lot of it is copy/pasted from various articles and tweeked as necessary.

Option Explicit

Public Sub ImportNestedContactGroups()
'***IMPORTANT***
'***Workbook should be saved as Nested Contact Groups***
'***Worksheet should be saved as Sheet1***
'***COLUMN A SHOULD HAVE 'Nested Contact Group Name' AS THE NAME IN A1 WITHOUT QUOTES***
'***COLUMN B SHOULD HAVE 'Contact 1' AS THE NAME IN B1 WITHOUT QUOTES***
'***COLUMN C SHOULD HAVE 'Contact 2' AS THE NAME IN C1 WITHOUT QUOTES***
'***COLUMN D SHOULD HAVE 'Contact 3' AS THE NAME IN D1 WITHOUT QUOTES***
'***COLUMN E SHOULD HAVE 'Contact 4' AS THE NAME IN E1 WITHOUT QUOTES***
'***COLUMN F SHOULD HAVE 'Contact 5' AS THE NAME IN F1 WITHOUT QUOTES***
'Excel specific variables
    Dim xlWorkbook As Excel.Workbook
    Dim xlWorksheet As Excel.Worksheet
'Outlook specific variables
    Dim CurrentFolder As Outlook.Folder
    Dim oDL As Outlook.DistListItem
    Dim objDLFromFile As Outlook.DistListItem
    Dim oMail As Outlook.MailItem
'Other variables
    Dim strFile As String
    Dim strDLName As String
    Dim strDLFromFile As String
'Sets the file path to the Nested Contact Groups file
'***WHAT'S IN QUOTES MUST BE UPDATED WITH THE FILE PATH FOR THE GIVEN COMPUTER***
    strFile = ("FILE PATH GOES HERE")
'Sets xlWorkbook to the workbook at the path above
    Set xlWorkbook = Workbooks.Open(strFile, False, True)
'Sets and activates the worksheet, which should be called Sheet1
    Set xlWorksheet = xlWorkbook.Worksheets("Sheet1")
    xlWorkbook.Activate
'Sets whatever folder you're currently in to CurrentFolder
    Set CurrentFolder = Outlook.ActiveExplorer.CurrentFolder
    Set oMail = Outlook.CreateItem(olMailItem)
'Idiot proofs
    If CurrentFolder.DefaultItemType <> olContactItem Then
        MsgBox "Please make your selection in a Contacts folder.", vbCritical, "Add Contacts to Contact Group"
        Exit Sub
    End If
'Pulls the DL name from the worksheet, creates it and names it
    strDLName = xlWorksheet.Range("A2")
    strDLFromFile = xlWorksheet.Range("B2")
    Set objDLFromFile = CurrentFolder.Items(strDLFromFile)
    oMail.Recipients.Add objDLFromFile.DLName
    If oMail.Recipients.ResolveAll Then
        Set oDL = Outlook.CreateItem(olDistributionListItem)
        oDL.DLName = strDLName
        oDL.AddMembers oMail.Recipients
        oDL.Save
    End If
'It creates the DL, names it correctly and saves it. That's it so far

[gmayor]

The following function will create or append members (or existing distribution lists) to a named distribution List. You can call it as many times as you have entries in your worksheet.
Using the format "Name (e-mail address)" for individual members or just the name for the list.

CreateDistributionList "ListName", "Name (e-mail address)" 'member
CreateDistributionList "ListName", "ListToAppend" 'list

Private Sub CreateDistributionList(strListName As String, strMember As String)
'Graham Mayor - http://www.gmayor.com - 28/09/2016
'strMember should be in the format "Name (e-mail address)"
'or Distribution list name
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.Folder
Dim olDistList As Outlook.DistListItem
Dim olFolderItems As Outlook.Items
Dim objRcpnt As Outlook.Recipient
Dim x As Integer
Dim y As Integer
Dim iCount As Integer
Dim bList As Boolean
Dim bMember As Boolean

    Set olNS = GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(olFolderContacts)
    Set olFolderItems = olFolder.Items
    bList = False
    bMember = False
    iCount = olFolderItems.Count
    For x = 1 To iCount
        If TypeName(olFolderItems.Item(x)) = "DistListItem" Then
            Set olDistList = olFolderItems.Item(x)
            'Check if the distribution list exists
            If olDistList.DLName = strListName Then
                bList = True
                For y = 1 To olDistList.MemberCount
                    'Check if the member exists
                    If InStr(1, olDistList.GetMember(y).Name, strMember) Then
                        bMember = True
                        Exit For
                    End If
                Next y
            End If
        End If
    Next x
    'If the distribution list doesn't exist - add it
    If Not bList Then
        Set olDistList = CreateItem(olDistributionListItem)
        olDistList.DLName = strListName
    End If
    'If the member doesn't exist add it
    If Not bMember Then
        Set objRcpnt = olNS.CreateRecipient(strMember)
        objRcpnt.Resolve
        olDistList.AddMember objRcpnt
    End If
    'Save the change to the list
    olDistList.Save
lbl_Exit:
    Set olNS = Nothing
    Set olFolder = Nothing
    Set olDistList = Nothing
    Set olFolderItems = Nothing
    Set objRcpnt = Nothing
    Exit Sub
End Sub

[Moragtao]

Thank you for this, however it's still giving me the same problem I was having before. If I try to use this to add just a contact to the distlist, it works like a charm. However, if I use this to try to add a previous distlist to the new distlist, it still doesn't work. It'll create the new distlist, but won't add the previous one to it.

EDIT: I tried it with a different contact group name, and it sort of worked. It added the name of the contact group, but nothing else.

[gmayor]

I take it that the named lists to be added are in the contacts list in question and the spelling of the names is correct?

[Moragtao]

That was the first thing I checked. But yes, they're in the contact list and the spelling is correct. It seems to sort of work; it'll work with certain contact groups, but it skips over others completely. I put a break at the 'If olDistList.DLName = strListName Then' line to check the value of olDistList as the for loop goes, and it seems to skip over the first few contact groups.

EDIT: I just want to make sure I'm using your function correctly. strListName should be the name of the nested contact group, and strMember should be either a name of a contact, or a name of a previously existing contact group. Is that correct?

[Moragtao]

It seems to have no issues if I'm pulling a contact group from the Offline Global Contact List, but if I try and pull one from my personal contacts(which is the default folder), it either skips over them completely or it tries to add it as a single contact instead of a group. I added a picture below to help explain. That first group, COL-Billing, came from the Offline Global Contact list and works like a charm. But the second group, K-Z, came from my contacts folder and, even though it's set up as a contact group in there, the function put it in as a regular contact instead of as a group.

Example.jpg

[gmayor]

I can't explain it without access to your data, but it seems likely to relate to the validation of the addresses.

[Moragtao]

It's always more difficult when you can't physically see what's going on. I do appreciate the help you've given, it's at least gotten me further along than I was before.