Como contar rapidamente os e-mails enviados por mês em seu Outlook

Se você armazena e-mails enviados em várias pastas e agora deseja contar todos esses e-mails enviados por mês, leia este artigo. Aqui vamos apresentar uma maneira consideravelmente rápida de obtê-lo.

O artigo anterior – “Como contar rapidamente e-mails recebidos por data, mês ou ano via Outlook VBA” compartilhou uma maneira de contar e-mails por mês. No entanto, é capaz de processar os e-mails em uma pasta. Se você deseja contar e-mails em várias ou mesmo em todas as pastas de e-mail, use os outros meios. Assim, a seguir, iremos expor outra forma muito mais rápida para você.

Conte os e-mails enviados por mês

1. Para começar, acesse o editor VBA do Outlook via “Alt + F11”.
2. Em seguida, habilite a referência a “MS Excel Object Library” de acordo com “Como adicionar uma biblioteca de objetosrary Referência em VBA".
3. Depois disso, coloque o seguinte código VBA em um projeto ou módulo.

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

4. Em seguida, mova o cursor para a primeira sub-rotina.
5. Posteriormente, pressione “F5” para acionar esta macro.
6. Imediatamente aparecerá um arquivo Excel, que contém as contagens de e-mails enviados em cada mês, conforme a figura abaixo.

Não entre em pânico diante da corrupção do Outlook

Você pode ficar preocupado ao encontrar danos PST. No entanto, na realidade, é melhor você se acalmar o mais rápido possível. Como todos sabemos, o pânico é indefeso e até leva a problemas mais caóticos e sérios. Você deve manter a calma para considerar medidas, como pensar se você atualizou o backup e considerar como reparar PST – se deve recorrer a ferramentas de terceiros como DataNumen Outlook Repair ou entre em contato com profissionais relevantes.

Introdução do autor:

Shirley Zhang é especialista em recuperação de dados em DataNumen, Inc., líder mundial em tecnologias de recuperação de dados, incluindo consertar mdf e produtos de software de reparo do Outlook. Para mais informações visite www.datanumen.com