Как бързо да получите общия брой елементи в папка и всички нейни подпапки чрез Outlook VBA

Ако имате няколко подпапки в определена папка и сега искате да преброите елементите в тази папка и всички нейни подпапки, можете да използвате начина, представен в тази статия.

Като цяло, за да проверите общия брой елементи в една папка, имате два начина. Единият е да изберете тази папка и след това можете да видите броя на елементите в долния ляв ъгъл на лентата на състоянието. Другият е да промените свойствата на папката, за да я настроите да показва общия брой елементи. Ако обаче има няколко подпапки под тази папка, и двете посочени по-горе средства не могат да включат подпапките при броене. Следователно, ако искате да получите общия брой елементи в дадена папка и всички нейни подпапки, трябва да потърсите други средства, като например следното. Той използва VBA код за бързо постигане на такъв общ брой. Моля, прочетете, за да получите подробните стъпки и кодовете на VBA.

Вземете общия брой елементи в папка и всички нейни подпапки

1. В самото начало можете да start вашата програма Outlook, както обикновено.
2. След това натиснете бутоните „Alt + F11“, за да покажете редактора на Outlook VBA.
3. След това можете да отворите празен модул.
4. След това копирайте и поставете следните VBA кодове в този модул.

Sub CountItems()
    Dim objMainFolder As Outlook.Folder
    Dim lItemsCount As Long
 
    'Select a folder
    Set objMainFolder = Outlook.Application.Session.PickFolder
 
    If objMainFolder Is Nothing Then
       MsgBox "You choose select a valid folder!", vbExclamation + vbOKOnly, "Warning for Pick Folder"
    Else
       'Initialize the total count
       lItemsCount = 0
       Call LoopFolders(objMainFolder, lItemsCount)
    End If
 
    'Display a message for the total count
    MsgBox "There are " & lItemsCount & " items in the " & objMainFolder.Name & " folder Including its subfolders.", vbInformation, "Count Items"
End Sub

Sub LoopFolders(ByVal objCurrentFolder As Outlook.Folder, lCurrentItemsCount As Long)
    Dim objSubfolder As Outlook.Folder
 
    lCurrentItemsCount = lCurrentItemsCount + objCurrentFolder.Items.Count
 
    'Process all folders and subfolders recursively
    If objCurrentFolder.Folders.Count Then
       For Each objSubfolder In objCurrentFolder.Folders
           Call LoopFolders(objSubfolder, lCurrentItemsCount)
       Next
    End If
End Sub

5. След това трябва да промените нивото на защита на макроса на Outlook на ниско.
6. Накрая можете да опитате.

• В новия прозорец на макроса натиснете бутона F5.
• Веднага ще трябва да изберете папка.
• Веднага ще получите ново съобщение, подсказващо общия брой на елементите в избраната папка и всички нейни подпапки, като снимката по-долу:

Архивирайте стари предмети във времето

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

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

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