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

В этой статье вы узнаете, как легко распечатать список всех встреч, которые отображаются как «Занят» и запланированы на определенный диапазон дат.

Довольно легко просмотреть все календари, чтобы найти все занятые встречи в определенном диапазоне дат. Вы можете просто установить область поиска «Все элементы календаря». Затем найдите встречи с параметром «Показать время как», равным «Занят», и в пределах определенных часов.tart дата и дата окончания. Но таким образом, когда вы намереваетесь распечатать найденные встречи и переходите в «Файл»> «Печать», вы можете видеть, что доступен только «Стиль заметок». Это означает, что вы не можете распечатать найденные встречи в списке. Итак, если вы хотите распечатать список таких встреч, вы можете использовать следующий способ.

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

1. В самом начале запустите редактор Outlook VBA через «Alt + F11».
2. Затем во всплывающем окне «Microsoft Visual Basic для приложений» добавьте ссылку на «MS Excel Object Lib».rarу» в соответствии с «Как добавить объектную библиотекуrary Ссылка в VBA».
3. После этого поместите следующий код VBA в модуль.

Dim dStart, dEnd As Date
Dim objExcelApp As Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet

Sub PrintListOfAllBusyAppointments()
    Dim objStore As Store
    Dim objFolder As Folder
 
    dStart = InputBox("Enter the start date:", , Date)
    dEnd = InputBox("Enter the end date:", , Date + 30)
 
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
    objExcelApp.Visible = True
 
    With objExcelWorksheet
         .Cells(1, 1) = "Subject"
         .Cells(1, 1).Font.Bold = True
         .Cells(1, 2) = "Location"
         .Cells(1, 2).Font.Bold = True
         .Cells(1, 3) = "Start"
         .Cells(1, 3).Font.Bold = True
         .Cells(1, 4) = "End"
         .Cells(1, 4).Font.Bold = True
         .Cells(1, 5) = "In Folder"
         .Cells(1, 5).Font.Bold = True
    End With
 
    For Each objStore In Application.Session.Stores
        For Each objFolder In objStore.GetRootFolder.Folders
            If objFolder.DefaultItemType = olAppointmentItem Then
               Call ProcessFolders(objFolder)
            End If
        Next
    Next
 
    objExcelWorksheet.Columns("A:E").AutoFit
    objExcelWorksheet.PrintOut
    objExcelWorkbook.Close False
    objExcelApp.Quit
End Sub

Sub ProcessFolders(ByVal objCurFolder As Folder)
    Dim strFilter As String
    Dim objItems As Outlook.Items
    Dim objRestrictedItems As Outlook.Items
    Dim objAppointment As AppointmentItem
    Dim nLastRow As Integer
    Dim objSubFolder As Folder
 
    Set objItems = objCurFolder.Items
    objItems.IncludeRecurrences = True
    objItems.Sort "[Start]"
 
    'Get the appointments in the specific date range
    strFilter = "[Start] >= " & Chr(34) & dStart & " 00:00 AM" & Chr(34) & " AND [End] <= " & Chr(34) & dEnd & " 11:59 PM" & Chr(34)
    Set objRestrictedItems = objItems.Restrict(strFilter)

    For Each objAppointment In objRestrictedItems
        If objAppointment.BusyStatus = olBusy Then
           nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
 
           With objExcelWorksheet
                .Range("A" & nLastRow) = objAppointment.Subject
                .Range("B" & nLastRow) = objAppointment.Location
                .Range("C" & nLastRow) = objAppointment.Start
                .Range("D" & nLastRow) = objAppointment.End
                .Range("E" & nLastRow) = objCurFolder.FolderPath
           End With
        End If
    Next

    'Process all subfolders recursively
    If objCurFolder.Folders.Count > 0 Then
       For Each objSubFolder In objCurFolder.Folders
           Call ProcessFolders(objSubFolder)
       Next
    End If
End Sub

4. Позже щелкните первую подпрограмму и нажмите кнопку «F5».
5. Далее вам потребуется указать диапазон дат для поиска встреч.
6. Затем нажмите «ОК», чтобы продолжить выполнение макроса.
7. Наконец, когда макрос завершится, будет напечатан список занятых встреч в предопределенном диапазоне дат во всех папках календаря, как показано на снимке экрана ниже.

Борьба с тревожной коррупцией Outlook

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

Об авторе:

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