VBA to expand Outlook Distribution Group before send

[JonMcK]

Hi,
I have some code that checks the recipients of an email and edits the email if a specific email domain is found. The issue I have is that the code doesn’t work with distribution lists or contact groups. I have the following code that tells the user to expand their distribution lists but is there any way I can programmically expand the list rather than asking the user to do this?

For Each recip In recips
If recip.DisplayType = olDistList Or recip.DisplayType = olPrivateDistList Then
MsgBox "You need to expand your distribution lists!", vbOKOnly + vbCritical, “Cannot check addresses in distribution lists"
Cancel = True
Exit Sub
End If
Next


Thanks

[gmayor]

You don't need to expand the list in order to establish whether it contains an e-mail address. All you need are the name of the list and the e-mail address to find and then the following 'InDistList' function will establish whether the address is in the list. olListMember can be an e-mail address or a domain. If you want to check all lists, you can lose ', sDistListName as String' and the condition that relates to it:

Function InDistList(olListMember As String, sDistListName As String) As Boolean
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.Folder
Dim olDistList As Outlook.DistListItem
Dim olFolderItems As Outlook.Items
Dim sList As String
Dim x As Integer
Dim y As Integer
Dim iCount As Integer

    Set olNS = GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(olFolderContacts)
    Set olFolderItems = olFolder.Items
    iCount = olFolderItems.Count
    sList = ""
    For x = 1 To iCount
        If TypeName(olFolderItems.Item(x)) = "DistListItem" Then
            Set olDistList = olFolderItems.Item(x)
            If olDistList.DLName = sDistListName Then
                For y = 1 To olDistList.MemberCount
                    If InStr(1, olDistList.GetMember(y).Address, olListMember) Then
                        InDistList = True
                        Exit For
                    End If
                Next y
            End If
        End If
    Next x
lbl_Exit:
    Set olNS = Nothing
    Set olFolder = Nothing
    Set olFolderItems = Nothing
    Exit Function
End Function

[JonMcK]

Thank you for this and although it worked I did need to expand the DL, apologies for not explaining myself better in my initial post. However you did point me in the right direction, checking the recipients for Distribution Lists and the looping through the list members and adding their addresses to the To field. The following code does juts what I needed

Dim recips As Recipients
Dim recip As Recipient
Dim i As Long
Set recips = Item.Recipients
For Each recip In recips
If recip.AddressEntry.DisplayType <> olUser Then
For i = 1 To recip.AddressEntry.Members.Count
Item.Recipients.Add (recip.AddressEntry.Members.Item(i).Address)
Next
recip.Delete
End If
recips.ResolveAll
Next

Thanks Again

[skatonni]

Use a reverse count when you delete or you may miss some of the Distribution Lists.

You might want to try something like this if as well there could be nested Distribution Lists.

Option Explicit

Sub DLExpand()

Dim currItem As MailItem
Dim recips As Recipients
 
Dim innerDistListFound As Boolean
 
Dim i As Long
Dim j As Long

Set currItem = ActiveInspector.currentItem
innerDistListFound = True

Do Until innerDistListFound = False
 
    Set recips = currItem.Recipients
    innerDistListFound = False
    
    If recips.count = 0 Then GoTo ExitRoutine
 
    For j = recips.count To 1 Step -1
    
        'Debug.Print recips(j)
        
        If recips(j).AddressEntry.DisplayType <> olUser Then
        
            ' Expand the dist list
            For i = 1 To recips(j).AddressEntry.Members.count
            
                If recips(j).AddressEntry.Members.Item(i).DisplayType = olUser Then
                    currItem.Recipients.Add (recips(j).AddressEntry.Members.Item(i).Address)
                Else
                    currItem.Recipients.Add (recips(j).AddressEntry.Members.Item(i).Name)
                    innerDistListFound = True
                    'Debug.Print " innerDistListFound: " & innerDistListFound
                End If
                
                Debug.Print "- " & recips(j).AddressEntry.Members.Item(i).Name
        
            Next
    
            recips(j).Delete
            recips.ResolveAll
            DoEvents
       
        End If
 
    Next j
 
    recips.ResolveAll

Loop

ExitRoutine:
    Set currItem = Nothing
    Set recips = Nothing

'Debug.Print "Done."

End Sub

[JonMcK]

Thanks again, I'd not considered nested DLs, we don't actually use DLs that often but this really helps.

[azon2111]

Can someone tell me which code posting auto expands (assuming nesting doesn't matter) and how this is to be deployed into Outlook 2016 to auto expand all distro lists in the To, CC or BCC fields? Thank you for any help. We are using them to make it easy to email external email addresses but need them to be able to reply all.

Thank You for helping!

[skatonni]

Appears Members which was deprecated, can longer be used as needed here.

Members.Count produces 1 now.

https://msdn.microsoft.com/en-us/lib...roperties.aspx

"This object, member, or enumeration is deprecated and is not intended to be used in your code."

Whether there is still a way to expand a list is unknown.