Cómo registrar automáticamente el recuento total de correos electrónicos entrantes todos los días en un archivo de Excel

Este artículo le enseñará cómo permitir que Outlook cuente automáticamente cuántos correos electrónicos recibió cada día y escriba el número en un archivo de Excel.

Se requiere que muchos usuarios cuenten el número total de correos electrónicos recibidos cada día. Además, para una verificación más conveniente en el futuro, muchos están acostumbrados a registrar el recuento total en un archivo de Excel. En este caso, por supuesto, puede optar por contar y grabar manualmente todos los días. Sin embargo, es un poco problemático. Y puede que te olvides de hacerlo a veces. Por lo tanto, debe desear un método práctico que pueda hacer que Outlook lo haga automáticamente. En respuesta a este requisito, le enseñaremos cómo usar VBA para realizarlo a continuación.

Registre automáticamente el recuento total de correos electrónicos entrantes todos los días en un archivo de Excel

1. Desde el principio, inicie su aplicación Outlook.
2. Luego presione los accesos directos de las teclas "Alt + F11" en la ventana principal de Outlook.
3. A continuación, en la ventana emergente del editor de VBA, abra el proyecto "ThisOutlookSession".
4. Posteriormente, copie y pegue los siguientes códigos VBA en este proyecto.

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

5. A continuación, firme este código y cambie la configuración de macro de Outlook para permitir macros firmadas.
6. Después de eso, debe crear una tarea recurrente a diario.

• En primer lugar, haga clic en el botón "Nueva tarea" en el panel Tareas.
• En la ventana emergente Nueva tarea, haga clic en el botón "Recurrencia".
• Luego, en el cuadro de diálogo siguiente, seleccione "Diariamente", "Cada 1 día (s)" y "Sin fecha de finalización" y, por último, presione "Aceptar".
• Más tarde, cambie el tema de la tarea y el recordatorio según sus necesidades.
• Finalmente, haga clic en el botón "Guardar y cerrar".

7. A partir de ahora, cada vez que se alerta el recordatorio de esta tarea, Outlook contará automáticamente los correos electrónicos recibidos ayer y luego registrará el número en el archivo de Excel, como en la siguiente captura de pantalla:

Escape de la pérdida permanente de datos PST

Nadie está dispuesto a aceptar la pérdida permanente de datos PST. Sin embargo, el archivo PST de Outlook es propenso a la corrupción. Por lo tanto, debe tomar las precauciones necesarias, como realizar una copia de seguridad de datos PST coherente y actualizada y mantener una potente Recuperación de PST herramienta en las proximidades, como DataNumen Outlook Repair.

Introducción del autor:

Shirley Zhang es experta en recuperación de datos en DataNumen, Inc., que es el líder mundial en tecnologías de recuperación de datos, incluyendo reparación de sql y productos de software de reparación de Outlook. Para más información visite www.datanumen.com