如何使用vba对不在"联系人"文件夹中的通讯组列表的成员进行计数

Question

我正试图在excel中创建一个vba工具，该工具将遍历Outlook发送框中的项目，以计算每个项目的大小和收件人数量。当收件人实际上是通讯组列表时，我遇到了一个问题。我的代码将通讯组列表计算为一个收件人，而我需要它来计算列表中的成员。我发现了一个代码，它看起来像是要计算成员，但前提是通讯组列表在"联系人"文件夹中。然而，在我的组织中，我们所有的通讯组列表都保存在联系人文件夹之外的一个单独的地址列表中。有没有一种方法可以使用vba根据通讯组列表名称查找成员数量？提前谢谢。

更新：感谢您的回复。我的第一次尝试使用了"；AnalyseSentItems"；(下面(子循环通过项目和收件人，然后称为"；收件人计数"；函数尝试计算收件人总数。我得到了"；对象变量或With块未设置"；错误在"；AddressEntry.Members.Count"；。

Sub AnalyseSentItems()
'The code will loop through items in Sent Items created within the past n number of days
'and calculate the total size of items sent by multiplying the size of each item by the number of recipients
Dim oLItem As Object
Dim oMail As Outlook.MailItem
Dim RECP As Recipient, CntRecp As Integer, i As Integer
Dim DateSEnt As Date
Dim NoOfDays As Integer 'Number of days to look back on in Sent box
Dim olFolder As Outlook.MAPIFolder
Dim objNS As Outlook.Namespace ': Set objNS = GetNamespace("MAPI")
Dim Emailcnt As Integer, TotSize As Long
Dim innerDistListFound As Boolean
TotSize = 0
Emailcnt = 0
Set objNS = GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderSentMail)
NoOfDays = 2
For Each oLItem In olFolder.Items
CntRecp = 0
If oLItem.CreationTime > DateAdd("d", -2, Date) Then
'Calculate total number of recipients
For Each RECP In oLItem.Recipients
CntRecp = CntRecp + CountOfRecipients(RECP)
Next
Emailcnt = Emailcnt + CntRecp
TotSize = TotSize + oLItem.Size * oLItem.Recipients.Count
End If
Next oLItem

Debug.Print "+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" _
& vbCrLf & "Total Messages: " & Emailcnt & vbCrLf & "Total Size: " & TotSize _
& vbCrLf & "+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
End Sub

Function CountOfRecipients(RECP As Recipient) As Integer
Select Case RECP.AddressEntry.DisplayType
Case Is = 5, 1 'Displaytype is Exchange or Private Dist List
CountOfRecipients = RECP.AddressEntry.Members.Count
Case Else
CountOfRecipients = 1
End Select
End Function

我的第二次失败尝试使用了"；MemberCount"；函数，传入通讯组列表名称。这以"；尝试的操作失败。找不到对象"；。我想这是因为通讯组列表不在OLFolderContacts中。(它在我的"全球地址列表"中可见(。

Function MemberCount(DistListName As String) As Integer
Dim olApplication As Object
Dim olNamespace As Object
Dim olContactFolder As Object
Dim olDistListItem As Object
Const olFolderContacts As Long = 10
Set olApplication = CreateObject("Outlook.Application")
Set olNamespace = olApplication.GetNamespace("MAPI")
Set olContactFolder = olNamespace.GetDefaultFolder(olFolderContacts)
Set olDistListItem = olContactFolder.Items(DistListName)
MemberCount = olDistListItem.MemberCount
Set olApplication = Nothing
Set olNamespace = Nothing
Set olContactFolder = Nothing
Set olDistListItem = Nothing
End Function

感谢所有的指导。

Answer 1

处理收件人时，请选中Recipient.AddressEntry.Members。如果不是null(意味着它是DL(，请检查Members.Count属性。如果DL包含其他DL，您也可以递归地处理Members集合中的每个地址条目。

Answer 2

使用AddressEntry.DisplayType属性，该属性返回属于描述AddressEntry性质的OlDisplayType枚举的常量。因此，如果处理通讯组列表，可以尝试访问AddressEntry.Members属性。例如，以下是VBA代码示例：

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