如何通过 Outlook VBA 打印特定日期范围内所有忙碌约会的列表

本文将教您一种简单的方法来打印出所有显示为“忙碌”并安排在特定日期范围内的约会列表。

要遍历所有日历，查找特定日期范围内的所有繁忙预约，非常简单。只需将搜索范围设置为“所有日历项”，然后搜索“显示时间”为“忙碌”且开始日期和结束日期在指定范围内的预约即可。但是，这样一来，当您想打印找到的预约并转到“文件”>“打印”时，会发现只有“备忘录样式”可用。这意味着您无法以列表形式打印找到的预约。因此，如果您想打印此类预约的列表，可以使用以下方法。

打印特定日期范围内所有忙碌约会的列表

1. 首先，通过“Alt + F11”启动 Outlook VBA 编辑器。
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. 随后，单击“确定”继续宏。
7. 最后，当宏完成时，将打印所有日历文件夹中预定义日期范围内的忙碌约会列表，如下面的屏幕截图所示。

应对令人不安的前景腐败

如果您的 Outlook 总是以不正确的方式关闭，您以后可能会遇到很多问题。 其中，Outlook 文件损坏是最严重的一个。 如果您不想丢失数据，则需要使用 PST 修复工具，例如 DataNumen Outlook Repair. 它能够从中获取最大数据 损坏的外观 文件中。

作者简介：

Shirley Zhang 是一位数据恢复专家 DataNumen, Inc.，它是数据恢复技术领域的世界领先者，包括 修复 和 outlook 修复软件产品。 欲了解更多信息，请访问 datanumen.com