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

Тази статия ще ви научи на лесен метод за отпечатване на списъка с всички срещи, които са показани като „Заети“ и са планирани за определен период от време.

Доста лесно е да прегледате всички календари, за да намерите всички заети срещи в определен диапазон от дати. Можете просто да зададете обхват на търсене на „Всички елементи от календара“. След това търсете срещи с „Показване на времето като“ равно на „Зает“ и в рамките на определената начална и крайна дата. Но по този начин, когато възнамерявате да разпечатате намерените срещи и отидете на „Файл“ > „Печат“, можете да видите, че е наличен само „Стил на бележка“. Това означава, че не можете да разпечатате намерените срещи в списъка. Така че, ако искате да разпечатате списъка с такива срещи, можете да използвате следния начин.

Отпечатайте списъка с всички натоварени срещи за конкретен период от време

1. В самото начало стартирайте Outlook VBA редактор чрез „Alt + F11“.
2. След това, в изскачащия прозорец „Microsoft Visual Basic for Applications“, добавете препратката към „MS Excel Object Library“ в съответствие с „Как да добавите препратка към библиотека с обекти във 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. След това щракнете върху „OK“, за да продължите с макроса.
7. Накрая, когато макросът приключи, списъкът със заети срещи в предварително зададения период от време във всички папки на календара ще бъде отпечатан, както е показано на екранната снимка по-долу.

Справете се с обезпокоителната корупция в Outlook

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

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

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