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

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

В предишната ми статия - „Как бързо да получите общия брой елементи в папка и всички нейни подпапки чрез Outlook VBA”, Можете да научите метод, използващ VBA, за да получите броя на елементите в папка. По този начин обаче, ако искате да преброите елементите във всички папки, трябва да изберете всяка папка и да стартирате макроса един по един. Това е малко досадно. Затова ще ви научим на друг метод, който ще експортира броя в файл на Excel.

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

1. В самото начало стартирайте програмата си Outlook.
2. След това натиснете бутоните „Alt + F11“ в главния прозорец на Outlook.
3. След това ще влезете в прозореца „Microsoft Visual Basic for Applications“, в който трябва да отворите модул, който не се използва.
4. Впоследствие копирайте и поставете следния VBA код в този модул.

Public strExcelFile As String
Public objExcelApp As Excel.Application
Public objExcelWorkbook As Excel.Workbook
Public objExcelWorksheet As Excel.Worksheet

Sub Export_CountOfItems_InEachFolder_toExcel()
    Dim objSourcePST As Outlook.Folder
    Dim objFolder As Outlook.Folder
 
    'Create a new Excel file
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets("Sheet1")
    objExcelWorksheet.Cells(1, 1) = "Folder"
    objExcelWorksheet.Cells(1, 2) = "Count Items"
 
    'Select a source PST file
    Set objSourcePST = Outlook.Application.Session.PickFolder

    For Each objFolder In objSourcePST.folders
        Call ProcessFolders(objFolder)
    Next
 
    'Fit the columns from A to B
    objExcelWorksheet.Columns("A:B").AutoFit
 
    strExcelFile = "E:\Outlook\" & objSourcePST.Name & " Folder Items Count (" & Format(Now, "yyyy-mm-dd hh-mm-ss") & ").xlsx"
    objExcelWorkbook.Close True, strExcelFile

    MsgBox "Complete!", vbExclamation
End Sub

Sub ProcessFolders(ByVal objCurrentFolder As Outlook.Folder)
    Dim objItem As Object
    Dim lCurrentFolderItemCount As Long
    Dim nLastRow As Integer
 
    lCurrentFolderItemCount = objCurrentFolder.Items.Count
 
    nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1

    'Add the values into the columns
    objExcelWorksheet.Range("A" & nLastRow) = objCurrentFolder.FolderPath
    objExcelWorksheet.Range("B" & nLastRow) = lCurrentFolderItemCount
 
    If objCurrentFolder.folders.Count > 0 Then
       For Each objSubfolder In objCurrentFolder.folders
           Call ProcessFolders(objSubfolder)
       Next
    End If
End Sub

5. След това трябва да промените нивото на защита на макроса на Outlook на ниско.
6. След това можете да се върнете към новодобавения макрос и да натиснете бутона F5, за да стартирате този макрос.
7. След това трябва да изберете изходен PST файл и да натиснете „OK“.
8. След завършване на макроса можете да отидете в предварително дефинираната локална папка, за да намерите новия файл на Excel, който ще изглежда като следната екранна снимка:

Уредете досадни PST грешки

Може би сте срещали различни проблеми по време на използването на Outlook. За да се справите с малките проблеми, можете просто да прибегнете до инструмент за ремонт на входящата кутия. Независимо от това, ако проблемите са толкова сериозни, че надхвърлят възможностите на вградения инструмент, трябва да използвате по-мощен инструмент, като DataNumen Outlook Repair.

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

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