The following will add a member to an existing named list or create a new named list and add the member to it if the named list doesn't exist
Call the function as follows
CreateDistributionList "my address list", "John Doe (myEmailAddress)"
Private Function 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)"
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
Exit For
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)
If objRcpnt.Resolve = True Then
olDistList.Display
olDistList.AddMember objRcpnt
Else
MsgBox strMember & vbCr & " Not Resolved"
End If
End If
'Save the change to the list
olDistList.Close olSave
lbl_Exit:
Set olNS = Nothing
Set olFolder = Nothing
Set olDistList = Nothing
Set olFolderItems = Nothing
Set objRcpnt = Nothing
Exit Function
End Function