Как быстро экспортировать общее количество элементов в каждой папке Outlook в Excel

Если вы хотите получить отчет о количестве элементов в каждой папке Outlook, вы можете использовать метод, представленный в этой статье. Он быстро проведет подсчет и экспортирует результаты в файл Excel.

В моей предыдущей статье — «Как быстро получить общее количество элементов в папке и всех ее подпапках через Outlook VBA», вы можете изучить метод, использующий VBA, чтобы получить количество элементов в папке. Однако, таким образом, если вы хотите подсчитать элементы во всех папках, вам нужно выбрать каждую папку и запустить макрос один за другим. Это немного утомительно. Поэтому мы научим вас другому методу, который позволит экспортировать счет в файл Excel.

Экспорт общего количества элементов в каждой папке Outlook в Excel

1. Сначала запустите программу Outlook.
2. Затем нажмите клавиши «Alt + F11» в главном окне Outlook.
3. Далее вы попадете в окно «Microsoft Visual Basic для приложений», в котором вам нужно открыть неиспользуемый модуль.
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 и нажать «ОК».
8. После завершения макроса вы можете перейти в предопределенную локальную папку, чтобы найти новый файл Excel, который будет выглядеть следующим образом:

Устранить раздражающие ошибки PST

Возможно, вы сталкивались с различными проблемами при использовании Outlook. Чтобы решить мелкие проблемы, вы можете просто прибегнуть к инструмент для ремонта входящих. Тем не менее, если проблемы настолько серьезны, что они выходят за рамки того, что может сделать встроенный инструмент, вам придется использовать более мощный инструмент, например DataNumen Outlook Repair.

Об авторе:

Ширли Чжан — эксперт по восстановлению данных в DataNumen, Inc., которая является мировым лидером в области технологий восстановления данных, включая ремонт мдф и программные продукты для ремонта Outlook. Для получения дополнительной информации посетите www.datanumen.com