Outlook-da göndərilən e-poçtları aya görə necə tez saymaq olar

Göndərilən e-poçtları bir neçə qovluqda saxlayırsınızsa və indi bütün bu göndərilmiş məktubları aylar üzrə saymaq istəyirsinizsə, bu məqaləni oxuya bilərsiniz. Burada onu əldə etməyin olduqca sürətli bir yolunu təqdim edəcəyik.

Əvvəlki məqalə - "Outlook VBA vasitəsilə daxil olan e-poçtları tarix, ay və ya il üzrə necə tez saymaq olar” e-poçtları aylara görə saymağın yolunu paylaşdı. Bununla belə, e-poçtları bir qovluqda emal edə bilir. Bir neçə və ya hətta bütün poçt qovluqlarında e-poçtları saymaq istəyirsinizsə, digər vasitələrdən istifadə etməlisiniz. Beləliklə, aşağıda sizə daha sürətli bir yol təqdim edəcəyik.

Göndərilən e-poçtları aya görə sayın

1. Başlamaq üçün "Alt + F11" vasitəsilə Outlook VBA redaktoruna daxil olun.
2. Sonra, “MS Excel Object Library” görə “Necə Obyekt Lib əlavə etmək olarrary VBA-da istinad".
3. Bundan sonra, aşağıdakı VBA kodunu layihə və ya modula qoyun.

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. Sonra kursoru birinci alt proqrama köçürün.
5. Daha sonra bu makronu işə salmaq üçün “F5” düyməsini sıxın.
6. Aşağıdakı şəkildə göstərildiyi kimi, dərhal, hər ay göndərilən e-poçtların sayını ehtiva edən Excel faylı görünəcək.

Outlook Korrupsiyasına Qarşı Panik etməyin

PST zədəsi ilə qarşılaşdığınız zaman narahat ola bilərsiniz. Bununla belə, əslində, mümkün qədər tez sakitləşmək daha yaxşıdır. Hamımızın bildiyi kimi, çaxnaşma acizdir və hətta daha xaotik və ciddi problemlərə gətirib çıxarır. Siz ehtiyat nüsxəsini yeniləyib-yeniləmədiyinizi və necə edəcəyinizi düşünmək kimi tədbirləri nəzərdən keçirmək üçün sakit olmalısınız təmir PST – kimi üçüncü tərəf alətinə müraciət edib-etməmək DataNumen Outlook Repair və ya müvafiq mütəxəssislərlə əlaqə saxlayın.

Müəllif Giriş:

Shirley Zhang məlumatların bərpası üzrə mütəxəssisdir DataNumendaxil olmaqla məlumatların bərpası texnologiyaları üzrə dünya lideri olan , Inc təmir mdf və Outlook təmiri proqram məhsulları. Ətraflı məlumat üçün ziyarət edin www.datanumen.com