如何在 Excel 文件中自动记录每天收到的电子邮件总数

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

本文将教您如何让 Outlook 自动统计您每天收到的电子邮件数量，并将该数字写入 Excel 文件。

许多用户需要统计每天收到的电子邮件总数。另外，为了方便日后核对，很多人习惯于将总数记录在Excel文件中。这种情况下，你当然可以选择每天手动统计和记录。不过，有点麻烦。有时您可能会忘记这样做。因此，您需要一种方便的方法，可以让 Outlook 自动完成。针对这一需求，下面教大家如何使用VBA实现。

在 Excel 文件中自动记录每天收到的电子邮件总数

首先，启动您的 Outlook 应用程序。
然后在 Outlook 主窗口中按“Alt + F11”快捷键。
接下来在弹出的 VBA 编辑器窗口中，打开“ThisOutlookSession”项目。
随后，将以下 VBA 代码复制并粘贴到该项目中。

Private Sub Application_Reminder(ByVal Item As Object)
    If Item.Class = olTask And Item.Subject = "Update Email Count" Then
       Call GetAllInboxFolders
    End If
End Sub

Private Sub GetAllInboxFolders()
    Dim objInboxFolder As Outlook.Folder
    Dim strExcelFile As String
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim nNextEmptyRow As Integer
    Dim lEmailCount As Long
 
    lEmailCount = 0
    Set objInboxFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Call UpdateEmailCount(objInboxFolder, lEmailCount)
 
    ‘Change the path to the Excel file
    strExcelFile = "E:\Email\Email Count.xlsx"
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Open(strExcelFile)
    Set objExcelWorksheet = objExcelWorkbook.Sheets("Sheet1")
 
    nNextEmptyRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
 
    'Add the values into the columns
    objExcelWorksheet.Range("A" & nNextEmptyRow) = nNextEmptyRow - 1
    objExcelWorksheet.Range("B" & nNextEmptyRow) = Year(Date - 1) & "-" & Month(Date - 1) & "-" & Day(Date - 1)
    objExcelWorksheet.Range("C" & nNextEmptyRow) = lEmailCount
 
    'Fit the columns from A to C
    objExcelWorksheet.Columns("A:C").AutoFit
   
    'Save the changes and close the Excel file
    objExcelWorkbook.Close SaveChanges:=True
End Sub

Private Sub UpdateEmailCount(objFolder As Outlook.Folder, ByRef lCurEmailCount As Long)
    Dim objItems As Outlook.Items
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim strDay As String
    Dim strReceivedDate As String
    Dim lEmailCount As Long
    Dim objSubFolder As Outlook.Folder
 
    Set objItems = objFolder.Items
 
    objItems.SetColumns ("ReceivedTime")
    strDay = Year(Date - 1) & "-" & Month(Date - 1) & "-" & Day(Date - 1)
 
    For Each objItem In objItems
        If objItem.Class = olMail Then
           Set objMail = objItem
           strReceivedDate = Year(objMail.ReceivedTime) & "-" & Month(objMail.ReceivedTime) & "-" & Day(objMail.ReceivedTime)
           If strReceivedDate = strDay Then
              lCurEmailCount = lCurEmailCount + 1
           End If
        End If
    Next
 
    'Process the subfolders in the folder recursively
    If (objFolder.Folders.Count > 0) Then
       For Each objSubFolder In objFolder.Folders
           Call UpdateEmailCount(objSubFolder, lCurEmailCount)
       Next
    End If
End Sub

接下来，签署此代码并更改您的 Outlook 宏设置以允许签署的宏。
之后，您需要每天创建一个重复性任务。

首先，单击“任务”窗格中的“新建任务”按钮。
在弹出的新任务窗口中，单击“重复”按钮。
然后在随后的对话框中，选择“每天”、“每1天”和“无结束日期”，最后点击“确定”。
稍后根据您的需要更改任务主题和提醒。
最后单击“保存并关闭”按钮。

从现在开始，每次这个任务的提醒提醒，Outlook都会自动统计昨天收到的邮件，然后记录到Excel文件中，如下截图：

避免永久性 PST 数据丢失

没有人愿意接受 PST 数据永久丢失。但是，Outlook PST 文件很容易损坏。因此，您应该采取足够的预防措施，例如制作一致且最新的 PST 数据备份并保持强大的太平洋标准时间恢复附近的工具，例如 DataNumen Outlook Repair.

作者简介：

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