如何快速導出每種顏色類別中的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 是最推薦的修復工具之一。它可以 維修展望 麻煩中的問題。

作者簡介：

Shirley Zhang是的數據恢復專家 DataNumen，Inc.是數據恢復技術的全球領導者，包括 損壞的MDF 和Outlook修復軟件產品。 欲了解更多信息，請訪問 萬維網。datanumen.COM