Как автоматически записывать общее количество входящих писем каждый день в файл Excel

В этой статье вы узнаете, как разрешить Outlook автоматически подсчитывать количество писем, которые вы получаете каждый день, и записывать число в файл Excel.

Многим пользователям необходимо подсчитывать общее количество электронных писем, полученных каждый день. Кроме того, для более удобной проверки в будущем многие привыкли записывать общий счет в файл Excel. В этом случае, конечно, вы можете выбрать ежедневный подсчет и запись вручную. Однако это немного хлопотно. И вы можете забыть сделать это иногда. Поэтому вам нужен удобный метод, который может заставить Outlook делать это автоматически. В ответ на это требование мы научим вас, как использовать VBA для его реализации в следующих разделах.

Автоматическая запись общего количества входящих писем каждый день в файле Excel

1. В самом начале запустите приложение Outlook.
2. Затем нажмите сочетание клавиш «Alt + F11» в главном окне Outlook.
3. Затем во всплывающем окне редактора VBA откройте проект ThisOutlookSession.
4. Затем скопируйте и вставьте в этот проект следующие коды 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

5. Затем подпишите этот код и измените настройки макроса Outlook, чтобы разрешить подписанные макросы.
6. После этого вам нужно ежедневно создавать повторяющуюся задачу.

• Во-первых, нажмите кнопку «Новая задача» на панели «Задачи».
• Во всплывающем окне «Новая задача» нажмите кнопку «Повторить».
• Затем в следующем диалоговом окне выберите «Ежедневно», «Каждый 1 день (дни)» и «Без даты окончания» и, наконец, нажмите «ОК».
• Позже измените тему задачи и напоминание в соответствии с вашими потребностями.
• В конце нажмите кнопку «Сохранить и закрыть».

7. С этого момента каждый раз, когда появляется напоминание об этой задаче, Outlook будет автоматически подсчитывать электронные письма, полученные вчера, а затем записывать число в файл Excel, как показано на следующем снимке экрана:

Спасение от постоянной потери данных PST

Никто не готов принять безвозвратную потерю данных PST. Однако файл Outlook PST подвержен повреждению. Таким образом, вы должны принять достаточные меры предосторожности, например, сделать непротиворечивую и актуальную резервную копию данных PST и сохранить мощный восстановление PST инструмент поблизости, например DataNumen Outlook Repair.

Об авторе:

Ширли Чжан — эксперт по восстановлению данных в DataNumen, Inc., которая является мировым лидером в области технологий восстановления данных, включая ремонт sql и программные продукты для ремонта Outlook. Для получения дополнительной информации посетите www.datanumen.com