Как подсчитать количество отправленных писем в Outlook за месяц?

АвторСяоянДата изменения2024-09-18

Иногда бывает полезно узнать, сколько писем вы отправляли каждый месяц. В этом руководстве приведён код VBA, который поможет вам подсчитать количество отправленных писем по месяцам в Outlook.

Подсчёт количества отправленных писем в месяц в Outlook с помощью кода VBA

Примените приведённый ниже код VBA, чтобы получить количество отправленных писем за каждый месяц, как показано ниже:

1. Удерживая нажатыми клавиши ALT + F11, откройте окно Microsoft Visual Basic for Applications.

2. Нажмите Вставка > Модуль и вставьте следующий код в окно Модуля.

Код VBA: подсчёт количества отправленных писем в месяц:

Dim GDictionary As Object
Sub CountSentMailsByMonth()
'Updateby Extendoffice
Dim xSentFolder As Outlook.Folder
Dim xExcelApp As Excel.Application
Dim xWb As Excel.Workbook
Dim xWs As Excel.Worksheet
Dim xMonths As Variant
Dim xItemsCount As Variant
Dim xLastRow As Integer
Dim I As Integer
Dim xAccount As Account
On Error Resume Next
Set GDictionary = CreateObject("Scripting.Dictionary")
For Each xAccount In Application.Session.Accounts
  If VBA.LCase$(xAccount.SmtpAddress) = VBA.LCase$("yy@addin99.com") Then  'Specify the Email Account
    Set xSentFolder = xAccount.DeliveryStore.GetDefaultFolder(olFolderSentMail)
    If xSentFolder.DefaultItemType = olMailItem Then
      Call ProcessFolders(xSentFolder)
    End If
  End If
Next
Set xSentFolder = Nothing
Set xExcelApp = CreateObject("Excel.Application")
xExcelApp.Visible = True
Set xWb = xExcelApp.Workbooks.Add
Set xWs = xWb.Sheets(1)
With xWs
  .Cells(1, 1) = "Month"
  .Cells(1, 2) = "Count"
  .Cells(1, 1).Font.Bold = True
  .Cells(1, 2).Font.Bold = True
  .Cells(1, 1).HorizontalAlignment = xlCenter
  .Cells(1, 2).VerticalAlignment = xlCenter
End With
xMonths = GDictionary.Keys
xItemsCount = GDictionary.Items
For I = LBound(xMonths) To UBound(xMonths)
  xLastRow = xWs.Range("A" & xWs.Rows.Count).End(xlUp).Row + 1
  With xWs
    .Cells(xLastRow, 1) = xMonths(I)
    .Cells(xLastRow, 2) = xItemsCount(I)
  End With
Next
xWs.Columns("A:B").AutoFit
xExcelApp.Visible = True
Set xExcelApp = Nothing
Set xWb = Nothing
Set xWs = Nothing
End Sub

Sub ProcessFolders(ByVal Fld As Outlook.Folder)
Dim I As Long
Dim xMail As Outlook.MailItem
Dim xMonth As String
Dim xSubFolder As Folder
On Error Resume Next
For I = Fld.Items.Count To 1 Step -1
  If Fld.Items(I).Class = olMail Then
    Set xMail = Fld.Items(I)
    xMonth = Year(xMail.SentOn) & "/" & Month(xMail.SentOn)
    If GDictionary.Exists(xMonth) Then
      GDictionary(xMonth) = GDictionary(xMonth) + 1
    Else
      GDictionary.Add xMonth, 1
    End If
  End If
Next
If Fld.Folders.Count > 0 Then
  For Each xSubFolder In Fld.Folders
    Call ProcessFolders(xSubFolder)
  Next
End If
End Sub

Примечание: в коде замените адрес электронной почты «yy@addin99.com» на свой собственный.

3. Не закрывая окно Microsoft Visual Basic for Applications, выберите в меню пункты Сервис > Ссылки. В диалоговом окне Ссылки — Проект установите флажок напротив пункта Microsoft Excel 16,0 Object Library в списке Доступные ссылки (см. снимок экрана):

doc-count-sent-emails-per-month-1

4. Затем нажмите кнопку ОК, чтобы закрыть диалоговое окно, и клавишу F5, чтобы запустить код. После этого откроется файл Excel с количеством отправленных писем за каждый месяц для указанной учётной записи (см. снимок экрана):

doc-count-sent-emails-per-month-2

AI Mail Assistant в Outlook: умные ответы, чёткая коммуникация (волшебство в один клик!)

Оптимизируйте повседневные задачи в Outlook с помощью AI Mail Assistant от Kutools для Outlook — мощного инструмента, который анализирует ваши прошлые письма, чтобы предлагать точные и умные ответы, улучшать содержание сообщений и помогать легко создавать и редактировать тексты.

Эта функция поддерживает:

Умные ответы: получайте персонализированные, точные и готовые к отправке ответы, созданные на основе ваших прошлых переписок.
Улучшайте контент автоматически: делайте текст письма более ясным и выразительным.
Лёгкое составление: просто укажите ключевые слова — и ИИ сделает всё остальное, предложив несколько стилей письма.
Интеллектуальные дополнения: расширяйте свои идеи с помощью контекстно-зависимых предложений.
Резюмирование: мгновенно получайте краткие обзоры длинных писем.
Глобальный охват: легко переводите свои письма на любой язык.

Эта функция поддерживает:

Умные ответы на письма
Оптимизированный контент
Черновики на основе ключевых слов
Интеллектуальное расширение контента
Резюмирование писем
Многоязыковой перевод

Не ждите —скачайте AI Mail Assistant прямо сейчас и наслаждайтесь!

Лучшие инструменты для повышения продуктивности в Office

Оцените совершенно новый Kutools для Outlook с 100+ потрясающими функциями!Нажмите, чтобы скачать прямо сейчас!

🤖KUTOOLS AI:Использует передовые технологии ИИ для простой работы с электронной почтой: ответы, резюмирование, оптимизация, расширение, перевод и создание писем.

📧Автоматизация электронной почты: Автоответ (доступен для POP и IMAP) / Планирование отправки писем / Авто Копия/Скрытая копия по правилам при отправке писем / Автоматическое перенаправление (расширенное правило) / Автоматическое добавление приветствия / Автоматическое разделение писем с несколькими получателями на отдельные сообщения…

📨Управление электронной почтой: Отзыв письма / Блокировка мошеннических писем по темам и другим параметрам / Удаление дубликатов писем / Расширенный поиск / Организация папок…

📁Продвинутая работа с вложениями: Пакетное сохранение / Пакетное отсоединение / Пакетное сжатие / Автосохранение / Автоматическое отсоединение / Автоматическое сжатие…

🌟Волшебный интерфейс: 😊Еще больше красивых и стильных эмодзи / Напоминание о важных письмах / Сворачивание Outlook вместо закрытия…

👍Чудеса в один клик: Ответить всем с вложениями / Защита от фишинговых писем / 🕘Отображение часового пояса: текущее время отправителя…

👩🏼‍🤝‍👩🏻Контакты и календарь: Пакетное добавление контактов из выбранных писем / Разделение группы контактов на отдельные / Удаление напоминания о дне рождения…

Используйте Kutools на предпочитаемом языке — поддержка английского, испанского, немецкого, французского, китайского и более чем 40 других языков!

Мгновенно получите доступ к Kutools для Outlook одним кликом! Не теряйте времени — скачайте прямо сейчас и повысьте свою эффективность!

Список функций Kutools для Outlook Скачать сейчас Перейти к покупке

🚀 Скачать одним кликом — Получите все надстройки для Office

Настоятельно рекомендуется: Kutools for Office (5 в 1)

Скачайте одним кликом пять установщиковсразу —Kutools для Excel, Outlook, Word, PowerPointи Office Tab Pro.Нажмите, чтобы скачать прямо сейчас!

✅Удобство в один клик: Скачайте все пять установочных пакетов одним щелчком.
🚀Готовы к любой задаче в Office: устанавливайте нужные надстройки именно тогда, когда они вам понадобятся.
🧰Входит в комплект: Kutools для Excel / Kutools для Outlook / Kutools для Word / Office Tab Pro / Kutools for PowerPoint

О пакете ⬇ Скачать пакет 💳 Приобрести пакет