Як надрукувати список усіх зайнятих зустрічей у певному діапазоні дат через Outlook VBA

Рішення для Outlook Вересень 29, 2025
Поділитися зараз:

Ця стаття навчить вас простому способу роздрукувати список усіх зустрічей, які відображаються як "зайняті" та заплановані на певний діапазон дат.

Досить легко переглянути всі календарі, щоб знайти всі зайняті зустрічі в певному діапазоні дат. Ви можете просто встановити область пошуку на «Усі елементи календаря». Потім шукайте зустрічі з параметром «Показати час як» рівним «Зайнятий» та в межах певної дати початку та дати закінчення. Але таким чином, якщо ви збираєтеся роздрукувати знайдені зустрічі та перейдете до «Файл» > «Друк», ви побачите, що доступний лише «Стиль нагадування». Це означає, що ви не можете роздрукувати знайдені зустрічі у списку. Отже, якщо ви хочете роздрукувати список таких зустрічей, ви можете скористатися наступним способом.

Для знайдених зустрічей доступний лише пам’ятний стиль

Роздрукуйте список усіх зайнятих зустрічей у певний діапазон дат

  1. З самого початку запустіть редактор Outlook VBA через “Alt + F11”.
  2. Потім у спливаючому вікні «Microsoft Visual Basic for Applications» додайте посилання на «Бібліотеку об’єктів MS Excel» відповідно до «Як додати посилання на бібліотеку об'єктів у 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

Код VBA - Друк списку всіх зайнятих зустрічей у певному діапазоні дат

  1. Пізніше клацніть на першу підпрограму та натисніть клавішу “F5”.
  2. Далі вам потрібно буде вказати діапазон дат для пошуку зустрічей.Вкажіть діапазон дат
  3. Згодом натисніть “OK”, щоб продовжити макрос.
  4. Нарешті, коли макрос закінчується, список зайнятих зустрічей у визначеному діапазоні дат у всіх папках календаря буде надруковано, як показано на скріншоті нижче.Надрукований список усіх зайнятих призначень у певний діапазон дат

Вирішення проблем, що турбують корупцію в Outlook

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

Вступ автора:

Ширлі Чжан - експерт із відновлення даних у DataNumen, Inc., яка є світовим лідером у галузі технологій відновлення даних, в тому числі sql виправити та перспективні програмні продукти для ремонту. Для отримання додаткової інформації відвідайте WWW.datanumen.com

Поділитися зараз:

Коментарі закриті.