按发件人计数 Email outlook VBA

Question

我必须为发件人计数 email 做一个宏

这是我的代码

    Dim objDictionary As Object
    Dim objInbox As Outlook.Folder
    Dim i As Long
    Dim objMail As Outlook.MailItem
    Dim strSender As String
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim varSenders As Variant
    Dim varItemCounts As Variant
    Dim nLastRow As Integer
 
    Set objDictionary = CreateObject("Scripting.Dictionary")
    Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
 
    For i = objInbox.Items.Count To 1 Step -1
        If objInbox.Items(i).Class = olMail Then
           Set objMail = objInbox.Items(i)
           strSender = objMail.SenderEmailAddress
 
           If objDictionary.Exists(strSender) Then
              objDictionary.Item(strSender) = objDictionary.Item(strSender) + 1
           Else
              objDictionary.Add strSender, 1
           End If
        End If
    Next

    Set objExcelApp = CreateObject("Excel.Application")
    objExcelApp.Visible = True
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
 
    With objExcelWorksheet
         .Cells(1, 1) = "Sender"
         .Cells(1, 2) = "Count"
    End With
 
    varSenders = objDictionary.Keys
    varItemCounts = objDictionary.Items
 
    For i = LBound(varSenders) To UBound(varSenders)
        nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
        With objExcelWorksheet
             .Cells(nLastRow, 1) = varSenders(i)
             .Cells(nLastRow, 2) = varItemCounts(i)
        End With
    Next
 
    objExcelWorksheet.Columns("A:B").AutoFit
End Sub

问题是当我执行代码时，我有这个问题在此处输入图像描述

错误说：底层安全系统找不到您的数字身份证

你能帮我吗？

Answer 1

首先，不需要遍历文件夹中的所有项目：

 For i = objInbox.Items.Count To 1 Step -1
        If objInbox.Items(i).Class = olMail Then

相反，您需要使用Items class 的Find / FindNext或Restrict方法来仅获取与您的条件相对应的项目。 在我写的文章中阅读更多关于这些方法的信息：

• 如何：使用 Find 和 FindNext 方法从文件夹中检索 Outlook 邮件项目（C#、VB.NET）
• 如何：使用限制方法从文件夹中检索 Outlook 邮件项目

例如，您可以使用以下搜索条件从特定发件人的 email 地址获取项目：

criteria = "@SQL=" & Chr(34) _ 
& "urn:schemas:httpmail:senderemail" & Chr(34) _ 
& " = 'some@email.com'"

或者更好：

 Filter = "@SQL=" & " urn:schemas:httpmail:senderemail Like '%some@email.com%'"

有关详细信息，请参阅使用字符串比较过滤项目。

对集合应用过滤器后，您可以查看Items class 的Count属性，它可以为您提供来自特定发件人的项目数。