Jak nahradit kategorii barev položky Outlooku VBA

Chcete-li nahradit barevnou kategorii položky aplikace Outlook, budete muset odstranit původní, protože je přiřazena nová kategorie. V tomto článku vás tedy naučíme, jak to automatizovat pomocí VBA.

Hlavním důvodem, proč používáme barevné kategorie v Outlooku, je lepší klasifikace a správa položek Outlooku. Navíc nám Outlook umožňuje přiřadit jednu nebo více barevných kategorií k jedné položce. Příliš mnoho kategorií přiřazených k jedné položce však může někdy zaplnit vaše klasifikační pravidla. Mnoho uživatelů proto chce místo kategorií překrytí nahradit barevnou kategorii. Zde vám vystavíme efektivní způsob.

Nahraďte kategorii barev položky aplikace Outlook

1. Hned na začátku spusťte aplikaci Outlook.
2. Poté přepněte na kartu „Vývojář“ a klikněte na tlačítko „Visual Basic“ nebo stiskněte klávesové zkratky „Alt + F11“.
3. Dále vstoupíte do okna „Microsoft Visual Basic for Applications“.
4. V tomto okamžiku byste měli dvakrát kliknout na projekt „ThisOutlookSession“ na levé straně a otevřít jej.
5. Následně zkopírujte následující kódy VBA do tohoto okna projektu.

Public WithEvents objExplorer As Outlook.Explorer
Public WithEvents objInspectors As Outlook.Inspectors
'Take Mailitem as an example
Public WithEvents objMail As Outlook.MailItem

Private Sub Application_Startup()
    Set objExplorer = Outlook.Application.ActiveExplorer
    Set objInspectors = Outlook.Application.Inspectors
End Sub

Private Sub objExplorer_Activate()
    On Error Resume Next
    Set objMail = objExplorer.Selection.Item(1)
End Sub

Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
    Set objMail = Inspector.CurrentItem
End Sub

Private Sub objMail_PropertyChange(ByVal Name As String)
    Dim strSpecificCategory As String
    Dim strCategories As String
    Dim varArray As Variant
    Dim i As Long
  
    If Name = "Categories" Then
       strCategories = objMail.Categories
       varArray = Split(objMail.Categories, ",")
       If UBound(varArray) >= 1 Then
          'If want to get a confirmation before removing the original category
          'Add the following lines
          'Dim strPrompt As String
          'Dim nResponse As Integer
          'strPrompt = "Do you want to remove the original color category?"
          'nResponse = MsgBox(strPrompt, vbQuestion + vbYesNo, "Color Category Assignment")
          'If nResponse = vbYes Then
          For i = 0 To UBound(varArray)
              'Remove the previous color categories
              varArray(1) = ""
              'Rebuild the categories
              objMail.Categories = Join(varArray, ",")
              Exit Sub
          Next i
          'End If
       End If
    End If
End Sub

6. Poté byste tomuto novému makru měli přiřadit digitální certifikát.
7. Později musíte zkontrolovat nastavení maker aplikace Outlook, abyste se ujistili, že jsou podepsaná makra povolena.
8. Nakonec byste měli restartovat Outlook, abyste aktivovali nový projekt VBA.
9. Od této chvíle bude pokaždé, když položce přiřadíte novou kategorii, automaticky odstraněna předchozí.

Řešení problémů se serverem Nettlesome

Protože Outlook je náchylný k chybám a poškozením, ve vašem Outlooku narazíte na různé problémy. Proto byste měli být dostatečně opatrní. Například je vhodné provádět pravidelné zálohy pro váš soubor PST. Navíc byste se měli zmocnit mocného Oprava PST nástroj, 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ě zotavit se Sql Server a výhledové softwarové produkty pro opravy. Pro více informací navštivte www.datanumen.com