Якщо ви зберігаєте надіслані електронні листи в декількох папках і тепер хочете порахувати всі ці надіслані листи за місяцями, ви можете прочитати цю статтю. Тут ми представимо значно швидкий спосіб отримати його.
Попередня стаття - “Як швидко підрахувати вхідні електронні листи за датою, місяцем або роком через Outlook VBA”Поділився способом підрахунку електронних листів за місяцями. Однак він може обробляти електронні листи в одній папці. Якщо ви хочете порахувати електронні листи в декількох або навіть у всіх папках пошти, вам слід скористатися іншими способами. Таким чином, у наступних розділах ми запропонуємо вам ще один набагато швидший спосіб.
Підрахуйте надіслані електронні листи за місяцями
- Для початку відкрийте редактор Outlook VBA за допомогою “Alt + F11”.
- Потім увімкніть посилання на “Ліцензія об’єктів MS Excelrarу ”відповідно до„Як додати бібліотеку об’єктаrary Довідка у 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 або зверніться до відповідних фахівців.
Вступ автора:
Ширлі Чжан - експерт із відновлення даних у DataNumen, Inc., яка є світовим лідером у галузі технологій відновлення даних, в тому числі ремонт mdf та перспективні програмні продукти для ремонту. Для отримання додаткової інформації відвідайте WWW.datanumen.com

