So zählen Sie schnell alle Aufgaben nach Status in Ihrem Outlook

Aufgaben können fünf Status haben: „Nicht begonnen“, „In Bearbeitung“, „Abgeschlossen“, „Wartet auf andere Person“ und „Verschoben“. Um alle Aufgaben schnell nach Status zu zählen, können Sie die in diesem Artikel beschriebene Methode verwenden.

Outlook ermöglicht es Benutzern, Aufgaben oder markierten Elementen einen Status zuzuweisen. Es gibt fünf Status: „Nicht begonnen“, „In Bearbeitung“, „Abgeschlossen“, „Wartet auf Bearbeitung“ und „Verschoben“. Möglicherweise haben Sie viele Aufgaben in Outlook, die unterschiedliche Status aufweisen. Um alle Aufgaben nach Status zu zählen, gehen Sie wie folgt vor.

Zählen Sie schnell alle Aufgaben nach Status

1. Starten Sie zunächst den Outlook VBA-Editor unter „So führen Sie VBA-Code in Outlook aus".
2. Aktivieren Sie anschließend im VBA-Editor die Verweise auf „MS Excel Object Library“ sowie „MS Scripting Runtime“ gemäß „Wie man in VBA einen Objektbibliotheksverweis hinzufügt".
3. Kopieren Sie anschließend den folgenden Code in ein nicht verwendetes Modul.

Dim objDictionary As New Scripting.Dictionary

Sub CountTasksByStatus()
    Dim objStore As Outlook.Store
    Dim objOutlookFile As Outlook.Folder
    Dim objFolder As Outlook.Folder
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim varStatuses As Variant
    Dim varTaskCounts As Variant
    Dim i As Integer
    Dim nLastRow As Integer
 
    'Count by Dictionary
    Set objDictionary = CreateObject("Scripting.Dictionary")
  
    'Process All Outlook data files
    For Each objStore In Application.Session.Stores
        Set objOutlookFile = objStore.GetRootFolder
        For Each objFolder In objOutlookFile.Folders
            If objFolder.DefaultItemType = olTaskItem Then
               Call ProcessTaskFolders(objFolder)
            End If
        Next
    Next
 
    'Export the counts to an Excel worksheet
    Set objExcelApp = CreateObject("Excel.Application")
    objExcelApp.Visible = True
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
 
    With objExcelWorksheet
        .Cells(1, 1) = "Status"
        .Cells(1, 1).Font.Bold = True
        .Cells(1, 2) = "Task Count"
        .Cells(1, 2).Font.Bold = True
    End With
 
    varStatuses = objDictionary.Keys
    varTaskCounts = objDictionary.Items
 
    For i = LBound(varStatuses) To UBound(varStatuses)
        nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
        With objExcelWorksheet
            .Cells(nLastRow, 1) = varStatuses(i)
            .Cells(nLastRow, 2) = varTaskCounts(i)
        End With
    Next
 
    objExcelWorksheet.Columns("A:B").AutoFit
End Sub

Sub ProcessTaskFolders(ByVal objCurFolder As Outlook.Folder)
    Dim objTask As Outlook.TaskItem
    Dim strStatus As String
    Dim objSubfolder As Outlook.Folder
 
    'Count tasks by status
    For Each objTask In objCurFolder.Items
        Select Case objTask.Status
               Case olTaskNotStarted
                    strStatus = "Not Started"
 
                    If objDictionary.Exists(strStatus) Then
                       objDictionary(strStatus) = objDictionary(strStatus) + 1
                    Else
                       objDictionary.Add strStatus, 1
                    End If
               Case olTaskInProgress
                    strStatus = "In Progress"
 
                    If objDictionary.Exists(strStatus) Then
                       objDictionary(strStatus) = objDictionary(strStatus) + 1
                    Else
                       objDictionary.Add strStatus, 1
                    End If
               Case olTaskComplete
                    strStatus = "Completed"
 
                    If objDictionary.Exists(strStatus) Then
                       objDictionary(strStatus) = objDictionary(strStatus) + 1
                    Else
                       objDictionary.Add strStatus, 1
                    End If
               Case olTaskWaiting
                    strStatus = "Waiting on someone else"
 
                    If objDictionary.Exists(strStatus) Then
                       objDictionary(strStatus) = objDictionary(strStatus) + 1
                    Else
                       objDictionary.Add strStatus, 1
                    End If
               Case olTaskDeferred
                    strStatus = "Deferred"
 
                    If objDictionary.Exists(strStatus) Then
                       objDictionary(strStatus) = objDictionary(strStatus) + 1
                    Else
                       objDictionary.Add strStatus, 1
                    End If
         End Select
    Next
 
    'Process all subfolders recursively
    If objCurFolder.Folders.Count > 0 Then
       For Each objSubfolder In objCurFolder.Folders
           Call ProcessTaskFolders(objSubfolder)
       Next
    End If
End Sub

4. Klicken Sie danach in das erste Unterprogramm und drücken Sie die Taste „F5“.
5. Sobald das Makro abgeschlossen ist, wird sofort ein neues Excel-Arbeitsblatt angezeigt, wie im folgenden Screenshot dargestellt. Es enthält die Anzahl der Aufgaben in verschiedenen Status.

Hüten Sie sich vor Fallstricken in Outlook

Outlook birgt eine Vielzahl von Risiken, einschließlich Viren, menschlichen Fehlern, Softwarefehlern sowie Hardwarefehlern usw. Wenn Sie Ihre wertvollen Outlook-Daten nicht verlieren möchten, müssen Sie stets vorsichtig sein. Einfach ausgedrückt, sollten Sie niemals unbekannte Anhänge oder verdächtige Links in die E-Mails herunterladen. Außerdem ist es nach Möglichkeit ratsam, ein bemerkenswertes Outlook-Fix-Dienstprogramm wie z DataNumen Outlook Repair, in der Nähe, anstatt sich ganz auf die zu verlassen Reparaturwerkzeug für den Posteingang.

Einführung des Autors:

Shirley Zhang ist eine Datenrettungsexpertin in DataNumen, Inc., das weltweit führend bei Datenwiederherstellungstechnologien ist, einschließlich SQL wiederherstellen und Outlook-Reparatursoftwareprodukte. Für weitere Informationen besuchen Sie www.datanumen.com €XNUMX