Как да записвате автоматично общия брой входящи имейли всеки ден във файл на 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. След това трябва да създавате повтаряща се задача всеки ден.

• Първо, щракнете върху бутона „Нова задача“ в прозореца на задачите.
• В изскачащия прозорец Нова задача щракнете върху бутона „Повторение“.
• След това в следващия диалогов прозорец изберете „Daily“, „Every 1 day (s)“ и „No end date“ и накрая натиснете „OK“.
• По-късно сменете темата и напомнянето на задачата според вашите нужди.
• В крайна сметка щракнете върху бутона „Запазване и затваряне“.

7. Отсега нататък, всеки път, когато предупрежденията за напомняне за тази задача Outlook, автоматично ще преброи получените вчера имейли и след това ще запише номера във файла на Excel, като следната екранна снимка:

Бягство от постоянна загуба на PST данни

Никой не е готов да приеме постоянна загуба на PST данни. Файлът на PST на Outlook обаче е склонен към повреда. Следователно трябва да предприемете достатъчно предпазни мерки, като например да направите последователно и актуално архивиране на PST данни и да поддържате мощна Възстановяване на PST инструмент в близост, като DataNumen Outlook Repair.

Въведение на автора:

Шърли Джанг е експерт по възстановяване на данни в DataNumen, Inc., която е световен лидер в технологиите за възстановяване на данни, включително sql ремонт и outlook софтуерни продукти за ремонт. За повече информация посетете WWW.datanumen.com