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/library/microsoft.office.interop.outlook.addressentry_properties.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.