Как бързо да експортирате броя на елементите във всяка цветна категория във вашия Outlook в Excel

Решения за Outlook Септември 29, 2025

Ако искате бързо да получите общия брой елементи във всяка категория цветове във вашия PST файл на Outlook, можете да използвате VBA кода, изложен в тази статия. Той ще експортира всички преброявания във файл на Excel директно за удобна проверка.

Понякога по някои причини може да искате да преброите колко елемента са във всяка категория цветове във файл с данни на Outlook. Като цяло можете да използвате незабавно търсене, за да направите броенето. Например първо кликнете в полето за търсене. След това щракнете върху бутона „Categorize” в лентата „Search” и изберете определена категория цветове от падащия списък. След това изберете „Всички елементи на Outlook“ в лентата „Обхват“. По-късно, след като търсенето завърши, всички елементи в избраната цветова категория ще бъдат изброени. Сега можете да видите броя на тези резултати от търсенето в долния ляв ъгъл на лентата на състоянието.

Без никакви съмнения, ако имате много цветови категории, по този начин броенето една по една ще бъде много досадно. Следователно, в отговор на това изискване, тук ще разкрием много бърз метод. Той директно ще експортира всички броя в файл на Excel.

Експортирайте броя на елементите във всяка цветна категория във вашия Outlook в Excel

На първо място, start вашето приложение на Outlook.
След това натиснете бутоните “Alt + F11” за достъп до редактора на Outlook VBA.
В следващия прозорец „Microsoft Visual Basic for Applications“ отворете празен модул.
След това можете да копирате следните VBA кодове в този прозорец на модула.

Public objDictionary As Object
Public objExcelApp As Excel.Application
Public objExcelWorkbook As Excel.Workbook
Public objExcelWorksheet As Excel.Worksheet
 
Sub ExportCountofItemsinEachColorCategories()
    Dim objCategories As Object
    Dim objCategory As Object
    Dim objPSTFile As Outlook.Folder
    Dim objFolder As Outlook.Folder
    Dim strExcelFile As String
 
    'Create a New Excel file
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets("Sheet1")
    objExcelWorksheet.Cells(1, 1) = "Color Category"
    objExcelWorksheet.Cells(1, 2) = "Count"
 
    'Find all the color categories
    Set objDictionary = CreateObject("Scripting.Dictionary")

    Set objCategories = Outlook.Application.Session.Categories
    For Each objCategory In objCategories
        objDictionary.Add objCategory.Name, 0
    Next
 
    Set objPSTFile = Outlook.Application.Session.PickFolder
 
    For Each objFolder In objPSTFile.Folders
        ProcessFolder objFolder
    Next
 
    'Save the new Excel file
    objExcelWorksheet.Columns("A:B").AutoFit
    strExcelFile = "E:\Outlook\Color Categories (" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ").xlsx"
    objExcelWorkbook.Close True, strExcelFile

    MsgBox "Complete!", vbExclamation
End Sub
 
Private Sub ProcessFolder(ByVal objCurrentFolder As Outlook.Folder)
    Dim objItem As Object
    Dim objSubFolder As Object
    Dim ArrayCategories As Variant
    Dim VarCategory As Variant
    Dim ArrayKey As Variant
    Dim ArrayItem As Variant
    Dim i As Long
    Dim nRow As Integer

    'Count the items in each color category via Dictionary object
    For Each objItem In objCurrentFolder.Items
        If objItem.Categories <> "" Then
           ArrayCategories = Split(objItem.Categories, ",")
           For Each VarCategory In ArrayCategories
               If objDictionary.Exists(VarCategory) = True Then
                  objDictionary.Item(VarCategory) = objDictionary.Item(VarCategory) + 1
               End If
          Next
        End If
    Next
 
    ArrayKey = objDictionary.Keys
    ArrayItem = objDictionary.Items
    nRow = 2
 
    'Input the information into the new Excel file
    For i = LBound(ArrayKey) To UBound(ArrayKey)
        objExcelWorksheet.Cells(nRow, 1) = ArrayKey(i)
        objExcelWorksheet.Cells(nRow, 2) = ArrayItem(i) & “ Items”
        nRow = nRow + 1
    Next
 
    'Process the subfolders recursively
    For Each objSubFolder In objCurrentFolder.Folders
        ProcessFolder objSubFolder
    Next
End Sub

След това проверете дали Outlook разрешава макроси.
Накрая можете да опитате.

Първо, натиснете бутона F5 в този нов макрос.
След това трябва да изберете изходен PST файл и да натиснете „OK“.
Когато получите съобщението, подканващо „Завършено“, можете да отидете на локалното устройство и да отворите предварително дефинираната папка за запазване на Excel файла.
Намерете и отворете файла на Excel. Ще изглежда като следното изображение:

Какво да направя, ако Outlook се срине внезапно

Въпреки че Outlook се предлага с множество мощни функции, с течение на времето ще се сблъсквате с различни проблеми във вашия Outlook. Например, Outlook може да се срива от време на време. В най-добрия случайtarting Outlook ще може да реши проблема. В най-лошия случай това може директно да доведе до повреда на PST данни. По това време ще използвате различни средства за ремонт PST файл, за да получите обратно максимални данни на Outlook, за които можете да се върнете към опитен инструмент като DataNumen Outlook Repair.

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

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