Πώς να μετρήσετε γρήγορα τα απεσταλμένα μηνύματα ανά μήνα στο Outlook

Εάν αποθηκεύετε τα απεσταλμένα μηνύματα ηλεκτρονικού ταχυδρομείου σε πολλούς φακέλους και τώρα θέλετε να μετρήσετε όλα αυτά τα απεσταλμένα μηνύματα ανά μήνα, μπορείτε να διαβάσετε αυτό το άρθρο. Εδώ θα παρουσιάσουμε έναν πολύ γρήγορο τρόπο για να το αποκτήσουμε.

Το προηγούμενο άρθρο - «Πώς να μετρήσετε γρήγορα εισερχόμενα μηνύματα ηλεκτρονικού ταχυδρομείου κατά ημερομηνία, μήνα ή έτος μέσω του Outlook VBA"Έχει μοιραστεί έναν τρόπο μέτρησης των μηνυμάτων ανά μήνα. Ωστόσο, είναι σε θέση να επεξεργαστεί τα μηνύματα ηλεκτρονικού ταχυδρομείου σε έναν φάκελο. Εάν θέλετε να μετρήσετε τα email σε πολλούς ή ακόμα και σε όλους τους φακέλους αλληλογραφίας, θα πρέπει να χρησιμοποιήσετε τα άλλα μέσα. Έτσι, στα ακόλουθα, θα σας παρουσιάσουμε έναν άλλο πολύ πιο γρήγορο τρόπο για εσάς.

Μετρήστε τα απεσταλμένα μηνύματα ανά μήνα

1. Αρχικά, αποκτήστε πρόσβαση στο πρόγραμμα επεξεργασίας του Outlook VBA μέσω του "Alt + F11".
2. Στη συνέχεια, ενεργοποιήστε την αναφορά στο "MS Excel Object Library "σύμφωνα με"Πώς να προσθέσετε ένα αντικείμενο Library Αναφορά στο VBA".
3. Μετά από αυτό, τοποθετήστε τον ακόλουθο κώδικα VBA σε ένα έργο ή ενότητα.

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. Στη συνέχεια, μετακινήστε τον κέρσορα στην πρώτη υπορουτίνα.
5. Στη συνέχεια, πατήστε "F5" για να ενεργοποιήσετε αυτήν τη μακροεντολή.
6. Αμέσως, θα εμφανιστεί ένα αρχείο Excel, το οποίο περιέχει τον αριθμό των αποσταλμένων μηνυμάτων ηλεκτρονικού ταχυδρομείου κάθε μήνα, όπως φαίνεται στην παρακάτω εικόνα.

Μην πανικοβληθείτε ενόψει της διαφθοράς του Outlook

Μπορεί να τείνετε να ανησυχείτε όταν αντιμετωπίζετε ζημιά PST. Ωστόσο, στην πραγματικότητα, καλύτερα να ηρεμήσετε το συντομότερο δυνατό. Όπως όλοι γνωρίζουμε, ο πανικός είναι αβοήθητος και οδηγεί ακόμη και σε πιο χαοτικά και σοβαρά προβλήματα. Θα πρέπει να διατηρήσετε την ηρεμία σας για να λάβετε μέτρα, όπως να σκεφτείτε εάν έχετε ενημερωμένο αντίγραφο ασφαλείας και να σκεφτείτε πώς να το κάνετε επισκευή PST - αν θα καταφύγετε σε εργαλείο τρίτων όπως DataNumen Outlook Repair ή επικοινωνήστε με σχετικούς επαγγελματίες.

Εισαγωγή συγγραφέα:

Η Shirley Zhang είναι ειδικός ανάκτησης δεδομένων στο DataNumen, Inc., η οποία είναι ο παγκόσμιος ηγέτης στις τεχνολογίες ανάκτησης δεδομένων, συμπεριλαμβανομένων επισκευή mdf και προϊόντα λογισμικού επισκευής προοπτικών. Για περισσότερες πληροφορίες επισκεφθείτε www.datanumen.com