毎日の受信メールの総数をExcelファイルに自動記録する方法

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

この記事では、Outlookで毎日受信した電子メールの数を自動的にカウントし、その数をExcelファイルに書き込む方法について説明します。

多くのユーザーは、毎日受信した電子メールの総数を数える必要があります。さらに、将来のより便利なチェックのために、多くの人が合計数をExcelファイルに記録することに慣れています。この場合、もちろん、毎日手動でカウントして記録することを選択できます。ただし、少し面倒です。そして、あなたは時々それをするのを忘れるかもしれません。したがって、Outlookに自動的に実行させることができる便利な方法が必要です。この要件に応えて、VBAを使用してそれを実現する方法を以下で説明します。

毎日の受信メールの総数をExcelファイルに自動記録

最初に、Outlookアプリケーションを起動します。
次に、Outlookのメインウィンドウで「Alt + F11」キーのショートカットを押します。
次に、ポップアップVBAエディターウィンドウで、「ThisOutlookSession」プロジェクトを開きます。
続いて、次のVBAコードをコピーしてこのプロジェクトに貼り付けます。

Private Sub Application_Reminder(ByVal Item As Object)
    If Item.Class = olTask And Item.Subject = "Update Email Count" Then
       Call GetAllInboxFolders
    End If
End Sub

Private Sub GetAllInboxFolders()
    Dim objInboxFolder As Outlook.Folder
    Dim strExcelFile As String
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim nNextEmptyRow As Integer
    Dim lEmailCount As Long
 
    lEmailCount = 0
    Set objInboxFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Call UpdateEmailCount(objInboxFolder, lEmailCount)
 
    ‘Change the path to the Excel file
    strExcelFile = "E:\Email\Email Count.xlsx"
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Open(strExcelFile)
    Set objExcelWorksheet = objExcelWorkbook.Sheets("Sheet1")
 
    nNextEmptyRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
 
    'Add the values into the columns
    objExcelWorksheet.Range("A" & nNextEmptyRow) = nNextEmptyRow - 1
    objExcelWorksheet.Range("B" & nNextEmptyRow) = Year(Date - 1) & "-" & Month(Date - 1) & "-" & Day(Date - 1)
    objExcelWorksheet.Range("C" & nNextEmptyRow) = lEmailCount
 
    'Fit the columns from A to C
    objExcelWorksheet.Columns("A:C").AutoFit
   
    'Save the changes and close the Excel file
    objExcelWorkbook.Close SaveChanges:=True
End Sub

Private Sub UpdateEmailCount(objFolder As Outlook.Folder, ByRef lCurEmailCount As Long)
    Dim objItems As Outlook.Items
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim strDay As String
    Dim strReceivedDate As String
    Dim lEmailCount As Long
    Dim objSubFolder As Outlook.Folder
 
    Set objItems = objFolder.Items
 
    objItems.SetColumns ("ReceivedTime")
    strDay = Year(Date - 1) & "-" & Month(Date - 1) & "-" & Day(Date - 1)
 
    For Each objItem In objItems
        If objItem.Class = olMail Then
           Set objMail = objItem
           strReceivedDate = Year(objMail.ReceivedTime) & "-" & Month(objMail.ReceivedTime) & "-" & Day(objMail.ReceivedTime)
           If strReceivedDate = strDay Then
              lCurEmailCount = lCurEmailCount + 1
           End If
        End If
    Next
 
    'Process the subfolders in the folder recursively
    If (objFolder.Folders.Count > 0) Then
       For Each objSubFolder In objFolder.Folders
           Call UpdateEmailCount(objSubFolder, lCurEmailCount)
       Next
    End If
End Sub

次に、このコードに署名し、Outlookマクロ設定を変更して署名付きマクロを許可します。
その後、毎日定期的なタスクを作成する必要があります。

まず、タスクペインの「新規タスク」ボタンをクリックします。
ポップアップの[新しいタスク]ウィンドウで、[繰り返し]ボタンをクリックします。
次に、次のダイアログボックスで、[毎日]、[1日ごと]、[終了日なし]を選択し、最後に[OK]をクリックします。
後で、必要に応じてタスクの件名とリマインダーを変更します。
最終的に「保存して閉じる」ボタンをクリックします。

これ以降、このタスクのリマインダーアラートが発生するたびに、Outlookは昨日受信した電子メールを自動的にカウントし、次のスクリーンショットのようにその数をExcelファイルに記録します。

永続的なPSTデータ損失からの脱出

PSTデータの永続的な損失を受け入れる人は誰もいません。ただし、OutlookのPSTファイルは破損する傾向があります。したがって、一貫性のある最新のPSTデータのバックアップを作成し、強力な状態を維持するなど、十分な予防策を講じる必要があります。 PST回復近くのツール、 DataNumen Outlook Repair.

著者紹介：

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