Outlookでステータス別にすべてのタスクをすばやくカウントする方法

Outlookソリューション 2025 年 9 月 29 日

タスクには、「未開始」、「進行中」、「完了」、「担当者待ち」、「延期」の5つのステータスがあります。すべてのタスクをステータス別に素早くカウントしたい場合は、この記事で紹介する方法をご利用ください。

Outlook では、タスクやフラグ付きアイテムにステータスを割り当てることができます。ステータスは「未開始」、「進行中」、「完了」、「他の担当者待ち」、「延期」の 5 種類です。Outlook には多数のタスクがあり、それぞれ異なるステータスになっている場合があります。すべてのタスクをステータス別にカウントしたい場合は、次の方法を使用できます。

すべてのタスクをステータス別にすばやくカウント

まず、「OutlookVBAエディターを起動します。OutlookでVBAコードを実行する方法"
次に、VBA エディターで、「MS Excel オブジェクトライブラリ」と「MS Scripting Runtime」への参照を「VBAでオブジェクトライブラリ参照を追加する方法"
次に、次のコードを未使用のモジュールにコピーします。

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

その後、最初のサブルーチンをクリックして「F5」キーを押します。
マクロが完了すると、次のスクリーンショットのように、新しいExcelワークシートがすぐに表示されます。さまざまなステータスのタスクの数が含まれています。

Outlookの落とし穴に注意してください

Outlookには、ウイルス、人為的エラー、ソフトウェアの障害、ハードウェアの障害など、さまざまなリスクがあります。したがって、貴重なOutlookデータを失いたくない場合は、常に注意を払う必要があります。簡単に言えば、電子メールに不明な添付ファイルや疑わしいリンクをダウンロードしないでください。さらに、可能であれば、次のような注目すべきOutlook修正ユーティリティを保持することをお勧めします。 DataNumen Outlook Repair、近くに、完全に依存する代わりに受信トレイ修復ツール.

著者紹介：

Shirley Zhangは、のデータ復旧の専門家です。 DataNumen、Inc。は、以下を含むデータ復旧技術の世界的リーダーです。 SQLを回復すると見通し修理ソフトウェア製品。詳細については、次のWebサイトをご覧ください。 WWW。datanumen.com