Jak rychle exportovat počet položek v každé kategorii barev v aplikaci Outlook do aplikace Excel

Pokud byste chtěli rychle získat celkový počet položek v každé kategorii barev v souboru Outlook PST, můžete použít kód VBA uvedený v tomto článku. Exportuje všechny počty do souboru aplikace Excel přímo pro vaši pohodlnou kontrolu.

Někdy z nějakého důvodu možná budete chtít spočítat, kolik položek je v každé barevné kategorii v datovém souboru Outlooku. Obecně můžete k počítání použít okamžité vyhledávání. Například nejprve klikněte do vyhledávacího pole. Poté klikněte na tlačítko „Kategorizovat“ na pásu karet „Hledat“ a v rozevíracím seznamu vyberte konkrétní kategorii barev. Dále vyberte „Všechny položky Outlooku“ ve skupině karet „Rozsah“. Později, po dokončení vyhledávání, budou vypsány všechny položky ve vybrané barevné kategorii. Počet těchto výsledků vyhledávání nyní vidíte v levém dolním rohu stavového řádku.

Bezpochyby, pokud máte spoustu barevných kategorií, bude počítání po jednom velmi zdlouhavé. Proto v reakci na tento požadavek zde představíme mnohem rychlejší metodu. Přímo exportuje všechny počty do souboru aplikace Excel.

Exportujte počet položek v každé kategorii barev ve vašem Outlooku do Excelu

1. Nejprve spusťte aplikaci Outlook.
2. Poté stiskněte klávesy „Alt + F11“ pro přístup k editoru Outlook VBA.
3. V následujícím okně „Microsoft Visual Basic for Applications“ otevřete prázdný modul.
4. Dále můžete zkopírovat následující kódy VBA do tohoto okna modulu.

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

5. Poté zkontrolujte, zda Outlook povoluje makra.
6. Nakonec to můžete vyzkoušet.

• Nejprve stiskněte klávesu F5 v tomto novém makru.
• Poté musíte vybrat zdrojový soubor PST a stisknout „OK“.
• Když se zobrazí zpráva s výzvou „Dokončeno“, můžete přejít na místní jednotku a otevřít předdefinovanou složku pro uložení souboru aplikace Excel.
• Vyhledejte a otevřete soubor aplikace Excel. Bude to vypadat jako na následujícím obrázku:

Co dělat, když se Outlook náhle zhroutí

Přestože Outlook nabízí řadu výkonných funkcí, časem se v něm můžete setkat s různými problémy. Například Outlook může čas od času havarovat. V nejlepším případě problém vyřeší restartování Outlooku. V nejhorším případě může přímo vést k poškození dat PST. V takovém případě budete používat různé prostředky k... opravit PST souboru, abyste získali zpět maximum dat Outlooku, u kterých se můžete vrátit ke zkušenému nástroji, jako je DataNumen Outlook Repair.

Ú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ě oprava sql a výhledové softwarové produkty pro opravy. Pro více informací navštivte www.datanumen.com