Jak rychle spočítat odeslané e-maily podle měsíce v aplikaci Outlook

Pokud ukládáte odeslané e-maily do několika složek a nyní byste chtěli všechny tyto odeslané e-maily počítat podle měsíce, můžete si přečíst tento článek. Zde představíme značně rychlý způsob, jak to získat.

Předchozí článek - „Jak rychle spočítat příchozí e-maily podle data, měsíce nebo roku prostřednictvím aplikace Outlook VBA”Sdílí způsob počítání e-mailů podle měsíce. Je však schopen zpracovat e-maily v jedné složce. Pokud chcete počítat e-maily v několika nebo dokonce ve všech složkách pošty, měli byste použít jiné prostředky. V následujících odstavcích vám tedy odhalíme další mnohem rychlejší cestu.

Počítejte odeslané e-maily podle měsíce

1. Nejprve přejděte do editoru Outlook VBA pomocí „Alt + F11“.
2. Poté povolte odkaz na „MS Excel Object Library “podle„Jak přidat objekt Library Reference ve VBA".
3. Poté vložte následující kód VBA do projektu nebo modulu.

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. Dále přesuňte kurzor do prvního podprogramu.
5. Poté stiskněte „F5“ pro spuštění tohoto makra.
6. Najednou se zobrazí soubor Excel, který obsahuje počty odeslaných e-mailů v každém měsíci, jak je znázorněno na obrázku níže.

Nepropadejte panice tváří v tvář korupci aplikace Outlook

Při poškození PST můžete mít strach. Ve skutečnosti byste se ale měli uklidnit co nejdříve. Jak všichni víme, panika je bezmocná a vede dokonce k chaotičtějším a vážnějším problémům. Měli byste zůstat v klidu, abyste zvážili opatření, například přemýšlet o tom, zda máte aktualizovanou zálohu, a zvážit, jak na to opravit PST - zda se uchýlit k nástroji třetích stran jako DataNumen Outlook Repair nebo kontaktujte příslušné profesionály.

Úvod autora:

Shirley Zhang je expertem na obnovu dat DataNumen, Inc., která je světovým lídrem v oblasti technologií pro obnovu dat, včetně opravit mdf a výhledové softwarové produkty pro opravy. Pro více informací navštivte www.datanumen.com