如何在 Outlook 中按月快速统计已发送邮件

展望解决方案 2025 年 9 月 29 日

如果您将已发送的电子邮件存储在多个文件夹中，现在想按月统计所有这些已发送的邮件，您可以阅读这篇文章。在这里我们将介绍一种相当快速的获取方式。

上一篇文章——《如何通过 Outlook VBA 按日期、月份或年份快速计算收到的电子邮件”分享了一种按月计算电子邮件数量的方法。但是，它能够处理一个文件夹中的电子邮件。如果你想统计几个甚至所有邮件文件夹中的邮件，你应该使用其他方法。因此，接下来，我们将向您展示另一种更快捷的方法。

按月统计已发送邮件

首先，通过“Alt + F11”访问 Outlook VBA 编辑器。
然后，根据“启用对“MS Excel 对象库”的引用如何在 VBA 中添加对象库引用“。
之后，将以下 VBA 代码放入项目或模块中。

Dim objDictionary As Object

Sub CountSentMailsByMonth()
    Dim objOutlookFile As Outlook.Folder
    Dim objFolder As Outlook.Folder
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim varMonths As Variant
    Dim varItemCounts As Variant
    Dim nLastRow As Integer
 
    Set objDictionary = CreateObject("Scripting.Dictionary")
    Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
 
    'Get the default Outlook data file
    Set objOutlookFile = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Parent
 
    For Each objFolder In objOutlookFile.Folders
        If objFolder.DefaultItemType = olMailItem Then
           Call ProcessFolders(objFolder)
        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) = "Month"
        .Cells(1, 2) = "Count"
    End With
 
    varMonths = objDictionary.Keys
    varItemCounts = objDictionary.Items
 
    For i = LBound(varMonths) To UBound(varMonths)
        nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
        With objExcelWorksheet
            .Cells(nLastRow, 1) = varMonths(i)
            .Cells(nLastRow, 2) = varItemCounts(i)
        End With
    Next
 
    objExcelWorksheet.Columns("A:B").AutoFit
End Sub

Sub ProcessFolders(ByVal objCurFolder As Outlook.Folder)
    Dim i As Long
    Dim objMail As Outlook.MailItem
    Dim strMonth As String
 
    For i = objCurFolder.Items.Count To 1 Step -1
        If objCurFolder.Items(i).Class = olMail Then
           Set objMail = objCurFolder.Items(i)
           'Change to your own email address
           If objMail.SenderEmailAddress = "you@datanumen.com" Then
              strMonth = Format(Year(objMail.SentOn) & "-" & Month(objMail.SentOn), "YYYY/MM")
 
              If objDictionary.Exists(strMonth) Then
                 objDictionary(strMonth) = objDictionary(strMonth) + 1
              Else
                 objDictionary.Add strMonth, 1
              End If
           End If
       End If
    Next
End Sub

接下来，将光标移动到第一个子程序。
随后，按“F5”来触发这个宏。
马上会出现一个Excel文件，里面有每个月发送邮件的数量，如下图所示。

面对 Outlook 损坏不要惊慌

遇到 PST 损坏时，您可能会担心。然而，实际上，你最好尽快冷静下来。众所周知，恐慌是无奈的，甚至会导致更加混乱和严重的问题。您应该保持冷静考虑措施，例如考虑是否更新了备份并考虑如何修复PST – 是否求助于第三方工具，如 DataNumen Outlook Repair 或联系相关专业人士。

作者简介：

Shirley Zhang 是一位数据恢复专家 DataNumen, Inc.，它是数据恢复技术领域的世界领先者，包括修复中密度纤维板和 outlook 修复软件产品。欲了解更多信息，请访问 datanumen.com