如何快速导出在每个颜色类别的 Outlook 约会上花费的总时间

如果您想创建一份关于您在每个颜色类别的约会上花费的总时间的报告，您可以使用本文介绍的方法。 它可以帮助您快速完成此操作，而无需手动计数。

许多用户习惯于在 Outlook 日历中记录大部分活动。为了更轻松地管理和区分这些活动，他们会为每个活动分配类别。在这种情况下，一些用户希望生成一份报告，显示每个颜色类别中日历项目的总耗时。毫无疑问，手动计数和输入非常麻烦。因此，我们将在此分享一种只需单击一下即可完成此任务的方法。

导出在每个颜色类别的约会上花费的总时间

1. 首先，启动您的 Outlook 应用程序。
2. 然后，进入 Outlook 窗口后，您可以点击“Alt + F11”键按钮。
3. 随后，您将可以访问“Microsoft Visual Basic for Applications”窗口。
4. 接下来，您需要启用“Microsoft Excel 对象库”。您可以点击“工具”>“引用”来完成此操作。
5. 然后，您应该找到并打开一个未使用的模块。
6. 之后，您需要将以下 VBA 代码复制到该模块中。

Sub ExportTimeSpentOnAppointmentsInEachColorCategory()
    Dim objDictionary As Object
    Dim objAppointments As Outlook.Items
    Dim objAppointment As Outlook.AppointmentItem
    Dim strCategory As String
    Dim arrCategory As Variant
    Dim varCategory As Variant
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim arrKey As Variant
    Dim arrItem As Variant
    Dim i As Long
    Dim nLastRow As Integer
 
    Set objDictionary = CreateObject("Scripting.Dictionary")
    Set objAppointments = Application.Session.PickFolder.Items
  
    For Each objAppointment In objAppointments
        arrCategory = Split(objAppointment.Categories, ",")
        For Each varCategory In arrCategory
            strCategory = Trim(varCategory)
            If objDictionary.Exists(strCategory) Then
               objDictionary.Item(strCategory) = objDictionary.Item(strCategory) + objAppointment.Duration
            Else
               objDictionary.Add strCategory, objAppointment.Duration
            End If
        Next
    Next
 
    'Create a new Excel workbook
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
    objExcelApp.Visible = True
    objExcelWorkbook.Activate
 
    With objExcelWorksheet
         .Cells(1, 1) = "Color Category"
         .Cells(1, 1).Font.Bold = True
         .Cells(1, 1).Font.Size = 14
         .Cells(1, 2) = "Total Time (min)"
         .Cells(1, 2).Font.Bold = True
         .Cells(1, 2).Font.Size = 14
    End With
 
    arrKey = objDictionary.Keys
    arrItem = objDictionary.Items
 
    For i = LBound(arrKey) To UBound(arrKey)
        nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.count).End(xlUp).Row + 1
 
        objExcelWorksheet.Cells(nLastRow, 1) = arrKey(i)
        objExcelWorksheet.Cells(nLastRow, 2) = arrItem(i)
    Next

    objExcelWorksheet.Columns("A:B").AutoFit
End Sub

7. 最后你可以触发这个宏，无论是点击工具栏中的“运行”图标还是按“F5”键按钮。
8. 然后，您将被要求选择一个特定的日历。
9. 选择并点击“确定”后，宏将继续运行。 完成后，将在后台显示一个新的 Excel 文件。
10. 您可以访问它。 它将类似于以下屏幕截图：

留意您的 Outlook 周围的潜在威胁

Outlook 用户应注意所有潜在风险，包括未知的电子邮件附件、嵌入式链接和人为错误。 否则，您的 Outlook 随时可能损坏。 此外，定期备份 Outlook 数据并保留专门的修复工具是必要的。 DataNumen Outlook Repair 是最受推荐的修复工具之一。它可以 修复 Outlook 问题在一瞬间。

作者简介：

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