Kuidas Outlookis saadetud e-kirju kuude kaupa kiiresti loendada

Kui salvestate saadetud e-kirju mitmesse kausta ja soovite nüüd kõik saadetud kirjad kuude kaupa lugeda, saate seda artiklit lugeda. Siin tutvustame märkimisväärselt kiiret viisi selle saamiseks.

Eelmine artikkel - "Kuidas Outlook VBA kaudu kiiresti sissetulevaid e-kirju kuupäeva, kuu või aasta järgi loendada” on jaganud viisi, kuidas lugeda e-kirju kuude kaupa. Siiski suudab see e-kirju ühes kaustas töödelda. Kui soovite loendada kirju mitmes või isegi kõigis kirjakaustades, peaksite kasutama muid vahendeid. Seetõttu tutvustame teile järgnevalt veel ühte palju kiiremat viisi.

Loendage saadetud e-kirju kuude kaupa

1. Alustuseks avage Outlook VBA redigeerija "Alt + F11" abil.
2. Seejärel lubage viide "MS Excel Object Library" vastavalt "Kuidas lisada objektiliigrary Viide VBA-s".
3. Pärast seda pange projekti või moodulisse järgmine VBA kood.

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. Järgmisena liigutage kursor esimesse alamprogrammi.
5. Seejärel vajutage selle makro käivitamiseks klahvi "F5".
6. Kohe kuvatakse Exceli fail, mis sisaldab iga kuu saadetud meilide arvu, nagu on näidatud alloleval joonisel.

Ärge paanitsege Outlooki korruptsiooni ees

PST kahjustuse ilmnemisel võite olla mures. Kuid tegelikult on parem rahuneda niipea kui võimalik. Nagu me kõik teame, on paanika abitu ja viib isegi kaootilisemate ja tõsisemate probleemideni. Peaksite jääma rahulikuks, et kaaluda meetmeid, näiteks mõelda, kas olete varukoopiat värskendanud ja kuidas seda teha remont PST – kas kasutada näiteks kolmanda osapoole tööriistu DataNumen Outlook Repair või võtke ühendust vastavate spetsialistidega.

Autori sissejuhatus:

Shirley Zhang on andmete taastamise ekspert DataNumen, Inc., mis on maailmas juhtiv andmete taastamise tehnoloogiate, sealhulgas remont mdf ja Outlooki remonditarkvaratooted. Lisateabe saamiseks külastage www.datanumenCom