VBA Maintain Outlook DL list

Function UpdateDistList(EmailAddresses As String, DistName As String) As Boolean
' EmailAddresses: a comma-delimited string literal list of valid email addresses
' DistName: a string literal name for the distribution list

On Error GoTo ErrorHandler

Dim vAddr As Variant
vAddr = Split(EmailAddresses, ",")

' get Outlook
Dim olApp As Object ' Outlook.Application
Set olApp = GetOutlookApp

' create distribution list items
Dim objNS As Object          'Outlook.Namespace
Dim olDistListItem As Object ' Outlook.DistListItem
Dim objAddrList As Object ', objDist As Object
Dim objAddrEntry As Object
Dim objNewAddrEntry As Object
Dim tempMailItem As Object ' Outlook.MailItem
Dim tempRecipients As Object ' Outlook.Recipients


    Set objNS = olApp.GetNamespace("MAPI")
    Set objAddrList = objNS.Session.AddressLists("Global Address List") '.Items
    Debug.Print "TypeName(objAddrList) = " & TypeName(objAddrList)

    Set olDistListItem = objAddrList.AddressEntries(DistName)
    
    On Error GoTo 0
    If olDistListItem Is Nothing Then
        MsgBox "Distribution List " & DistName & " doesn 't exist", vbCritical
        GoTo ErrorHandler
    End If
    
    Debug.Print "TypeName(olDistListItem) = " & TypeName(olDistListItem)

    Debug.Print "Number of members in distribution list = " & olDistListItem.Members.Count
    Debug.Print "TypeName(olDistListItem.Members) = " & TypeName(olDistListItem.Members)
       
    Dim i As Integer
    For i = 1 To olDistListItem.Members.Count
        Debug.Print TypeName(olDistListItem.Members.Item(i)) & ", " & olDistListItem.Members.Item(i).Type
        Set objAddrEntry = olDistListItem.Members.Item(i)
        Debug.Print objAddrEntry.Name, objAddrEntry.Address
    Next
    
    Dim obj As Object
    Set obj = olDistListItem.Members

    For i = 0 To UBound(vAddr)
      Debug.Print "TypeName(obj) = " & TypeName(obj) & ", Count = " & obj.Count
      On Error Resume Next
      Set objNewAddrEntry = obj.Add("EX", , vAddr(i))
      Debug.Print Err.Description
      objNewAddrEntry.Update True, False
    Next i
    
    Debug.Print "Added member(s)"
    
    CreateDistList = True
    GoTo ExitProc

ErrorHandler:
    CreateDistList = False

ExitProc:
    Debug.Print "Cleaning up the variables ..."
    
    Set obj = Nothing
    Set tempRecipients = Nothing
    Set tempMailItem = Nothing
    Set olDistListItem = Nothing
    Set objAddrList = Nothing
    Set objNS = Nothing
    
    If bWeStartedOutlook Then
      olApp.Quit
    End If
    
    Set olApp = Nothing
End Function

***** Output **********
TypeName(objAddrList) = AddressList
TypeName(olDistListItem) = AddressEntry
Number of members in distribution list = 2
TypeName(olDistListItem.Members) = AddressEntries
AddressEntry, EX
Cassidy, Michael(NYK)   /O=BMW/OU=USA/cn=Recipients/cn=cassidmi
AddressEntry, EX
Kumar, Ganesh (NYK)       /O=BMW/OU=USA/cn=Recipients/cn=kumarg
TypeName(obj) = AddressEntries, Count = 2
The requested operation cannot be completed because the operation is not supported on this object.
Added member(s)
Cleaning up the variables ...

Select allOpen in new window