Cum să numărați rapid e-mailurile trimise pe lună în Outlook

Dacă stocați e-mailurile trimise în mai multe dosare și acum doriți să numărați toate aceste e-mailuri trimise pe lună, puteți citi acest articol. Aici vom introduce o modalitate considerabil de rapidă de a-l obține.

Articolul precedent – ​​„Cum să numărați rapid e-mailurile primite după dată, lună sau an prin Outlook VBA” a distribuit o modalitate de a număra e-mailurile pe lună. Cu toate acestea, este capabil să proceseze e-mailurile într-un singur folder. Dacă doriți să numărați e-mailurile în mai multe sau chiar în toate dosarele de e-mail, ar trebui să utilizați celelalte mijloace. Astfel, în cele ce urmează, vă vom expune o altă modalitate mult mai rapidă.

Numărați e-mailurile trimise pe lună

1. Pentru început, accesați editorul Outlook VBA prin „Alt + F11”.
2. Apoi, activați referința la „MS Excel Object Library” conform „Cum să adăugați un obiect Library Referință în VBA".
3. După aceea, introduceți următorul cod VBA într-un proiect sau modul.

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. Apoi, mutați cursorul în prima subrutină.
5. Ulterior, apăsați „F5” pentru a declanșa această macrocomandă.
6. Imediat, va apărea un fișier Excel, care conține numărul de e-mailuri trimise în fiecare lună, așa cum se arată în figura de mai jos.

Nu intrați în panică în fața corupției Outlook

Este posibil să aveți tendința de a fi îngrijorat când întâmpinați daune PST. Totuși, în realitate, ar fi bine să te calmezi cât mai curând posibil. După cum știm cu toții, panica este neputincioasă și chiar duce la probleme mai haotice și mai grave. Ar trebui să păstrați calmul pentru a lua în considerare măsuri, cum ar fi să vă gândiți dacă ați actualizat backup-ul și să vă gândiți cum să faceți repara PST – dacă să recurgeți la instrumente terțe, cum ar fi DataNumen Outlook Repair sau contactați profesioniști relevanți.

Introducerea autorului:

Shirley Zhang este expertă în recuperarea datelor DataNumen, Inc., care este lider mondial în tehnologiile de recuperare a datelor, inclusiv repara mdf și produse software de reparații Outlook. Pentru mai multe informații vizitați www.datanumen.com