Τρόπος γρήγορης εξαγωγής του αριθμού των αντικειμένων σε κάθε κατηγορία χρωμάτων στο Outlook στο Excel

Λύσεις του Outlook Σεπτέμβριος 29, 2025

Εάν θέλετε να λάβετε γρήγορα τον συνολικό αριθμό αντικειμένων σε κάθε κατηγορία χρωμάτων στο αρχείο Outlook PST, μπορείτε να χρησιμοποιήσετε τον κώδικα VBA που εκτίθεται σε αυτό το άρθρο. Θα εξάγει όλες τις μετρήσεις σε ένα αρχείο Excel απευθείας για τον βολικό σας έλεγχο.

Μερικές φορές, για ορισμένους λόγους, μπορεί να θέλετε να μετρήσετε πόσα στοιχεία είναι σε κάθε κατηγορία χρωμάτων σε ένα αρχείο δεδομένων του Outlook. Σε γενικές γραμμές, μπορείτε να χρησιμοποιήσετε την άμεση αναζήτηση για να κάνετε την καταμέτρηση. Για παράδειγμα, κάντε πρώτα κλικ στο πλαίσιο αναζήτησης. Στη συνέχεια, κάντε κλικ στο κουμπί "Κατηγοριοποίηση" στην κορδέλα "Αναζήτηση" και επιλέξτε μια συγκεκριμένη κατηγορία χρωμάτων από την αναπτυσσόμενη λίστα. Στη συνέχεια επιλέξτε "Όλα τα στοιχεία του Outlook" στην ομάδα κορδέλας "Πεδίο εφαρμογής". Αργότερα, μετά την ολοκλήρωση της αναζήτησης, όλα τα στοιχεία στην επιλεγμένη κατηγορία χρωμάτων θα καταχωριστούν. Τώρα μπορείτε να δείτε τον αριθμό αυτών των αποτελεσμάτων αναζήτησης στην κάτω αριστερή γωνία της γραμμής κατάστασης.

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

Εξαγάγετε την καταμέτρηση στοιχείων σε κάθε κατηγορία χρωμάτων στο Outlook σας στο Excel

Αρχικά, ξεκινήστε την εφαρμογή Outlook.
Στη συνέχεια, πατήστε τα πλήκτρα "Alt + F11" για πρόσβαση στο πρόγραμμα επεξεργασίας του Outlook VBA.
Στο επόμενο παράθυρο "Microsoft Visual Basic for Applications", ανοίξτε μια κενή λειτουργική μονάδα.
Στη συνέχεια, μπορείτε να αντιγράψετε τους ακόλουθους κωδικούς VBA σε αυτό το παράθυρο λειτουργικής μονάδας.

Public objDictionary As Object
Public objExcelApp As Excel.Application
Public objExcelWorkbook As Excel.Workbook
Public objExcelWorksheet As Excel.Worksheet
 
Sub ExportCountofItemsinEachColorCategories()
    Dim objCategories As Object
    Dim objCategory As Object
    Dim objPSTFile As Outlook.Folder
    Dim objFolder As Outlook.Folder
    Dim strExcelFile As String
 
    'Create a New Excel file
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets("Sheet1")
    objExcelWorksheet.Cells(1, 1) = "Color Category"
    objExcelWorksheet.Cells(1, 2) = "Count"
 
    'Find all the color categories
    Set objDictionary = CreateObject("Scripting.Dictionary")

    Set objCategories = Outlook.Application.Session.Categories
    For Each objCategory In objCategories
        objDictionary.Add objCategory.Name, 0
    Next
 
    Set objPSTFile = Outlook.Application.Session.PickFolder
 
    For Each objFolder In objPSTFile.Folders
        ProcessFolder objFolder
    Next
 
    'Save the new Excel file
    objExcelWorksheet.Columns("A:B").AutoFit
    strExcelFile = "E:\Outlook\Color Categories (" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ").xlsx"
    objExcelWorkbook.Close True, strExcelFile

    MsgBox "Complete!", vbExclamation
End Sub
 
Private Sub ProcessFolder(ByVal objCurrentFolder As Outlook.Folder)
    Dim objItem As Object
    Dim objSubFolder As Object
    Dim ArrayCategories As Variant
    Dim VarCategory As Variant
    Dim ArrayKey As Variant
    Dim ArrayItem As Variant
    Dim i As Long
    Dim nRow As Integer

    'Count the items in each color category via Dictionary object
    For Each objItem In objCurrentFolder.Items
        If objItem.Categories <> "" Then
           ArrayCategories = Split(objItem.Categories, ",")
           For Each VarCategory In ArrayCategories
               If objDictionary.Exists(VarCategory) = True Then
                  objDictionary.Item(VarCategory) = objDictionary.Item(VarCategory) + 1
               End If
          Next
        End If
    Next
 
    ArrayKey = objDictionary.Keys
    ArrayItem = objDictionary.Items
    nRow = 2
 
    'Input the information into the new Excel file
    For i = LBound(ArrayKey) To UBound(ArrayKey)
        objExcelWorksheet.Cells(nRow, 1) = ArrayKey(i)
        objExcelWorksheet.Cells(nRow, 2) = ArrayItem(i) & “ Items”
        nRow = nRow + 1
    Next
 
    'Process the subfolders recursively
    For Each objSubFolder In objCurrentFolder.Folders
        ProcessFolder objSubFolder
    Next
End Sub

Μετά από αυτό, ελέγξτε αν το Outlook επιτρέπει μακροεντολές.
Τέλος, μπορείτε να δοκιμάσετε.

Αρχικά, πατήστε το πλήκτρο F5 σε αυτήν τη νέα μακροεντολή.
Στη συνέχεια, πρέπει να επιλέξετε ένα αρχείο PST προέλευσης και να πατήσετε "OK".
Όταν λάβετε το μήνυμα με το μήνυμα "Ολοκληρώθηκε", μπορείτε να μεταβείτε στην τοπική μονάδα δίσκου και να ανοίξετε τον προκαθορισμένο φάκελο για την αποθήκευση του αρχείου Excel.
Εντοπίστε και ανοίξτε το αρχείο Excel. Θα μοιάζει με την ακόλουθη εικόνα:

Τι πρέπει να κάνετε εάν το Outlook καταρρέει ξαφνικά

Παρόλο που το Outlook διαθέτει πολλές ισχυρές λειτουργίες, με την πάροδο του χρόνου θα αντιμετωπίσετε διάφορα προβλήματα στο Outlook σας. Για παράδειγμα, το Outlook μπορεί να παρουσιάσει σφάλμα κατά καιρούς. Στην καλύτερη περίπτωση, η επανεκκίνηση του Outlook θα είναι σε θέση να διορθώσει το πρόβλημα. Στη χειρότερη, μπορεί να οδηγήσει άμεσα σε καταστροφή δεδομένων PST. Σε αυτή την περίπτωση, θα χρησιμοποιήσετε διάφορα μέσα για να επισκευή PST αρχείο για να λάβετε τα μέγιστα δεδομένα του Outlook, για τα οποία μπορείτε να επαναλάβετε σε ένα έμπειρο εργαλείο όπως DataNumen Outlook Repair.

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

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