Outlookで送信された電子メールを月ごとにすばやくカウントする方法

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

送信済みメールを複数のフォルダーに保存していて、これらすべての送信済みメールを月ごとにカウントしたい場合は、この記事を読むことができます。ここでは、それを取得するためのかなり高速な方法を紹介します。

前の記事–「Outlook VBAを使用して、受信メールを日付、月、または年ですばやくカウントする方法」は、月ごとにメールをカウントする方法を共有しています。ただし、XNUMXつのフォルダでメールを処理することはできます。複数またはすべてのメールフォルダにあるメールを数えたい場合は、他の方法を使用する必要があります。したがって、以下では、別のはるかに迅速な方法を紹介します。

送信されたメールを月ごとに数える

まず、「Alt + F11」からOutlookVBAエディターにアクセスします。
次に、「MS Excel ObjectLib」への参照を有効にします。rar「y」によると「オブジェクトライブラリを追加する方法raryVBAでの参照"
その後、次のVBAコードをプロジェクトまたはモジュールに配置します。

Dim objDictionary As Object

Sub CountSentMailsByMonth()
    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 varMonths As Variant
    Dim varItemCounts As Variant
    Dim nLastRow As Integer
 
    Set objDictionary = CreateObject("Scripting.Dictionary")
    Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
 
    'Get the default Outlook data file
    Set objOutlookFile = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Parent
 
    For Each objFolder In objOutlookFile.Folders
        If objFolder.DefaultItemType = olMailItem Then
           Call ProcessFolders(objFolder)
        End If
    Next

    Set objExcelApp = CreateObject("Excel.Application")
    objExcelApp.Visible = True
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
 
    With objExcelWorksheet
        .Cells(1, 1) = "Month"
        .Cells(1, 2) = "Count"
    End With
 
    varMonths = objDictionary.Keys
    varItemCounts = objDictionary.Items
 
    For i = LBound(varMonths) To UBound(varMonths)
        nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
        With objExcelWorksheet
            .Cells(nLastRow, 1) = varMonths(i)
            .Cells(nLastRow, 2) = varItemCounts(i)
        End With
    Next
 
    objExcelWorksheet.Columns("A:B").AutoFit
End Sub

Sub ProcessFolders(ByVal objCurFolder As Outlook.Folder)
    Dim i As Long
    Dim objMail As Outlook.MailItem
    Dim strMonth As String
 
    For i = objCurFolder.Items.Count To 1 Step -1
        If objCurFolder.Items(i).Class = olMail Then
           Set objMail = objCurFolder.Items(i)
           'Change to your own email address
           If objMail.SenderEmailAddress = "you@datanumen.com" Then
              strMonth = Format(Year(objMail.SentOn) & "-" & Month(objMail.SentOn), "YYYY/MM")
 
              If objDictionary.Exists(strMonth) Then
                 objDictionary(strMonth) = objDictionary(strMonth) + 1
              Else
                 objDictionary.Add strMonth, 1
              End If
           End If
       End If
    Next
End Sub

次に、カーソルを最初のサブルーチンに移動します。
続いて、「F5」を押してこのマクロをトリガーします。
次の図に示すように、Excelファイルが表示されます。このファイルには、毎月送信された電子メールの数が含まれています。

Outlookの破損に直面してパニックにならないでください

PSTの損傷に遭遇すると、心配する傾向があります。しかし、実際には、できるだけ早く落ち着いたほうがいいでしょう。ご存知のように、パニックは無力であり、より混沌とした深刻な問題にさえつながります。バックアップを更新したかどうかを検討し、その方法を検討するなどの対策を検討するために、落ち着いて行動する必要があります PSTを修復する –次のようなサードパーティツールに頼るかどうか DataNumen Outlook Repair または関連する専門家に連絡してください。

著者紹介：

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