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.

19513

[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.